1 Abstract

There has already 2 years passed by while Binary.com-is-Rebranding-to-Deriv.com, Here I summarized some previous research papers in Binary.com → Deriv.com and continue from this high-frequency-trading.

if(!suppressPackageStartupMessages(require('BBmisc'))) {
  install.packages('BBmisc', dependencies = TRUE, INSTALL_opts = '--no-lock')
}
suppressPackageStartupMessages(require('BBmisc'))
# suppressPackageStartupMessages(require('rmsfuns'))

pkgs <- c('devtools', 'knitr', 'kableExtra', 'tint', 'dygraphs', 
          'devtools','readr', 'lubridate', 'data.table', 'reprex', 
          'feather', 'purrr', 'quantmod', 'tidyquant', 'plotly', 
          'tibbletime', 'furrr', 'flyingfox', 'tidyr', 'jsonlite', 
          'timetk', 'plyr', 'dplyr', 'stringr', 'magrittr', 'tdplyr', 
          'tidyverse', 'memoise', 'htmltools', 'formattable', 
          'dash', 'dashCoreComponents', 'dashHtmlComponents', ##https://dashr.plotly.com
          'zoo', 'forecast', 'seasonal', 'seasonalview', 'rjson', 
          'rugarch', 'rmgarch', 'mfGARCH', 'sparklyr', 'jcolors', 
          'microbenchmark', 'dendextend', 'lhmetools', 'ggthemr', 
          'stringr', 'pacman', 'profmem', 'DescTools', 'ggthemes', 
          'htmltools', 'echarts4r', 'viridis', 'hrbrthemes')

# https://github.com/mpiktas/midasr
# https://github.com/onnokleen/mfGARCH
# devtools::install_github("business-science/tibbletime")
# devtools::install_github("DavisVaughan/furrr")

suppressAll(lib(pkgs))
# load_pkg(pkgs)

funs <- c('uv_fx.R', 'opt_arma.R', 'multi_seasons.R', 
          'filterFX.R', 'filter_spec.R', 'mv_fx.R', 
          'task_progress.R', 'read_umodels.R', 'convertOHLC.R')
l_ply(funs, function(x) source(paste0('./function/', x)))

# spark_install()

# if(FALSE) {
  # Not run due to side-effects
#   spark_home_set()
#   }
# sc <- spark_connect(master = 'local')

#spark_install()
#sc <- spark_connect(master = 'local')

.cl = FALSE

Sys.setenv(TZ = 'Asia/Tokyo')
## options(knitr.table.format = 'html') will set all kableExtra tables to be 'html', otherwise need to set the parameter on every single table.
options(warn = -1, knitr.table.format = 'html')#, digits.secs = 6)
rm(pkgs, funs)

2 Introduction

By refer to GARCH模型中的ARIMA(p,d,q)参数最优化 and binary.com Interview Question I - Comparison of Univariate GARCH Models, we know Fractional Intergrated GJR-GARCH is the best fit model. This paper we compare the MIDAS, GARCH-MIDAS and Levy Process models. Here I also test another high frequency trading model mcmcsGARCH. These paper might consider as comparison interday trading before start the high frequency trading via Real Time FXCM.

High Frequency Financial Time Series Prediction - Machine Learning Approach introduce multilayer modelling for high-frequency-trading. binary.com Interview Question I - Tick-Data-HiLo For Daily Trading (Blooper) tried to use Hi-Lo daily dataset for modelling but failed. The paper recommend to use complete itraday dataset.

I noticed that buying early in the morning, around 5am eastern time, tends to give lower prices and selling around 10pm eastern time gives you the highest prices. The wording is weird but i want to know your opinions on how time of day affects the bitcoin trading market. Thank you.

Source : Time of day affects trading prices

From above quotes, we can know the seasonality of price trend daily, weekly, monthly or annually etc. MIDAS and mcsGARCH are the models designate for high frequency trading.

A Comparison of GARCH-class Models and MIDAS Regression with Application in Volatility Prediction and Value at Risk Estimation compares GARCH, eGARCH and MIDAS 3 models with normal and student distribution with matrix. The author concludes that the MIDAS model is the most accurate in volatility prediction but there is inconclusive for VaR 1% and 5%.

Note that there does not seem to be an option to use SARMA models in the “rugarch” package, so you will have to let the “S” part go. But if there is a seasonal pattern (and that is quite likely when it comes to tourist arrivals), you will have to account for it somehow. Consider using exogenous seasonal variables (dummies or Fourier terms) in the conditional mean model via the argument external.regressors inside the argument mean.model in function ugarchspec. Alternatively, note that a SARMA model corresponds to a restricted ARMA model. An approximation of SARMA could thus be an ARMA with the appropriate lag order but without the SARMA-specific parameter restrictions (since those might not be available in “rugarch”).

The quotes above describe about the seasonal factors onto the model which is similar with MIDAS model, kindly refer to Fitting ARIMA-GARCH model using “rugarch” package.

3 Data

3.1 Tick Data

3.1.1 Get Data

Due to the dataset gather via getSymbols('JPY=X', src='av', api.key=api, periodicity='intraday') is tidied but only 100 observations. Moreover I cannot select the time period from few years ago, therefore here I omit it and use the intraday data gather from real-time-fxcm/data/USDJPY/ from Y2015W1 to Y2018W27, due to the dataset is tick-data-base and more than 1 million observation per file (per week) and there has 4 years dataset where. Here I need to backtest day-by-day. There will be spent a long time to do.

cr_code <- c('AUDUSD=X', 'EURUSD=X', 'GBPUSD=X', 'CHF=X', 'CAD=X', 'CNY=X', 'JPY=X')

names(cr_code) <- c('AUDUSD', 'EURUSD', 'GBPUSD', 'USDCHF', 'USDCAD', 'USDCNY', 'USDJPY')
# names(cr_code) <- c('USDAUD', 'USDEUR', 'USDGBP', 'USDCHF', 'USDCAD', 'USDCNY', 'USDJPY')

dtr <- str_extract_all(getwd(), '.*/', '')[1]
dtr1 <- paste0(dtr, 'real-time-fxcm/data/')

## Read presaved FXCM data.
# mbase <- sapply(names(cr_code), function(x) readRDS(paste0('./data/', x, '.rds')) %>% na.omit)

fls <- sapply(names(cr_code), function(x) {
  dtr1 <- paste0(dtr1, x)
  list.files(dtr1, pattern = '^Y[0-9]{4}W[0-9]{1,2}.rds$') %>% 
    str_replace_all('.rds', '')
  })
fls[lengths(fls) == 0] <- NA_character_
fls[is.na(fls)] <- NULL

# AUDUSD <- sapply(fls[[1]], read_rds)
# EURUSD <- sapply(fls[[2]], read_rds)
# GBPUSD <- sapply(fls[[3]], read_rds)
# USDCHF <- sapply(fls[[4]], read_rds)
# USDCAD <- sapply(fls[[5]], read_rds)
# USDCNY <- sapply(fls[[6]], read_rds)
# mbase <- llply(as.list(fls[[7]]), read_rds) #185 files where 1 files contains 1 million observation.

## Here I take USDJPY as example...
dtr1s <- paste0(dtr1, names(fls[length(fls)]))
fs <- list.files(dtr1s, pattern = '^Y[0-9]{4}W[0-9]{1,2}.rds$') %>% 
  str_replace_all('.rds', '')
# eval(parse(text = paste0(fs, "<- readRDS('", fls[[7]], "') %>% as_tibble")))

t.unit <- c('seconds', 'minutes', 'hours', 'days', 'weeks', 'months', 'quarters', 'quarters')
## https://www.alphavantage.co/
## https://www.alphavantage.co/support/#api-key
# api = 'UL7EPVVEGDVC3TXC'
# getSymbols('JPY=X', src='av', api.key=api, periodicity='intraday')

binary.com Interview Question I - Multivariate GARCH Models concludes that the multivariate will be more accurate but due to save time, here I only use univariate for models comparison.

Due to high volume of dataset, here I only use USDJPY since the variance is higher than the rest of currencies.

## Read raw dataset.
#Y2015W1 <- read_rds(paste0(dtr1, '/', fls[[7]][1], '.rds')) %>% as_tibble

eval(parse(text = paste0(fs[1], "<- readRDS('", dtr1, "/", 
                         names(fls[length(fls)]), '/', fls[length(fls)][[1]][1], 
                         ".rds') %>% as_tibble")))

## raw dataset
Y2015W1
## # A tibble: 1,775,999 x 3
##    DateTime                  Bid   Ask
##    <fct>                   <dbl> <dbl>
##  1 01/04/2015 22:00:00.165  120.  121.
##  2 01/04/2015 22:00:00.197  120.  121.
##  3 01/04/2015 22:00:00.401  120.  121.
##  4 01/04/2015 22:00:00.712  120.  121.
##  5 01/04/2015 22:00:00.742  120.  121.
##  6 01/04/2015 22:00:00.786  120.  121.
##  7 01/04/2015 22:00:00.920  120.  121.
##  8 01/04/2015 22:00:00.926  120.  121.
##  9 01/04/2015 22:00:01.253  120.  121.
## 10 01/04/2015 22:00:01.259  120.  121.
## # ... with 1,775,989 more rows

Above table shows the raw tick-dataset (shows price fluctuation in mili-seconds). As we know that the variance in unit mili-second is almost 0. Therefore I refer to High Frequency GARCH: The multiplicative component GARCH (mcsGARCH) model and use 1 minute as 1 time unit, convert from univariate ask and univariate bid to be OHLC dataset.

3.1.2 Tidy Data

For example, the taylor data set from the forecast package contains half-hourly electricity demand data from England and Wales over about 3 months in 2000. It was defined as taylor <- msts(x, seasonal.periods=c(48,336).

Source Seasonal periods

A Review of Literature on Time Zone Difference and Trade study about trading across timezone and different country, if the timezone difference will affect the trading.

I would like to use R for time series analysis. I want to make a time-series model and use functions from the packages timeDate and forecast. I have intraday data in the CET time zone (15 minutes data, 4 data points per hour). On March 31st daylight savings time is implemented and I am missing 4 data points of the 96 that I usually have. On October 28th I have 4 data points too many as time is switched back. For my time series model I always need 96 data points, as otherwise the intraday seasonality gets messed up. Do you have any experiences with this? Do you know an R function or a package that would be of help to automat such data handling - something elegant? Thank you!

I had a similar problem with hydrological data from a sensor. My timestamps were in UTC+1 (CET) and did not switch to daylight saving time (UTC+2, CEST). As I didn’t want my data to be one hour off (which would be the case if UTC were used) I took the %z conversion specification of strptime. In ?strptime you’ll find: %z Signed offset in hours and minutes from UTC, so -0800 is 8 hours behind UTC. For example: In 2012, the switch from Standard Time to DST occured on 2012-03-25, so there is no 02:00 on this day. If you try to convert “2012-03-25 02:00:00” to a POSIXct-Object,

## https://stackoverflow.com/questions/29202021/r-how-to-extract-dates-from-a-time-series
getTStime <- function(ats){
  start <- start(ats)
  end <- end(ats)
  time <- list()
  time[[1]] <- start
  m <- 2
  while(!(identical(start, end))){
    start[2] <- start[2] + 1
    if (start[2]==1441){ #mins per day
      start[1] <- start[1] + 1
      start[2] <- 1
    }
    time[[m]] <- start
    m <- m + 1
  }
  return(time)
}

## https://stackoverflow.com/questions/13865172/handling-data-on-the-days-when-we-switch-to-daylight-savings-time-and-back-in-r
#> as.POSIXct("2012-03-25 02:00:00", tz="Europe/Vienna")
#[1] "2012-03-25 CET"
#
## you don't get an error or a warning, you just get date without the time (this behavior is documented).
## Using `format = "%z"` gives the desired result:
#
#> as.POSIXct("2012-03-25 02:00:00 +0100", format="%F %T %z", tz="Europe/Vienna")
#[1] "2012-03-25 03:00:00 CEST"

## function
as.POSIXct.no.dst <- function (
  x, tz = '', format='%Y-%m-%d %H:%M', offset='+0100', ...) {
  x <- paste(x, offset)
  format <- paste(format, '%z')
  res <- as.POSIXct(x, tz, format=format, ...)
  return(res)
  }

Source : Handling data on the days when we switch to daylight savings time and back in R

Why is this xts frequency always 1? talk about the frequency of xts dataset and we need to use zoo to convert it.

So far, we have considered relatively simple seasonal patterns such as quarterly and monthly data. However, higher frequency time series often exhibit more complicated seasonal patterns. For example, daily data may have a weekly pattern as well as an annual pattern. Hourly data usually has three types of seasonality: a daily pattern, a weekly pattern, and an annual pattern. Even weekly data can be challenging to forecast as it typically has an annual pattern with seasonal period of 365.25/7≈52.179 on average. … The top panel of Figure 11.1 shows the number of retail banking call arrivals per 5-minute interval between 7:00am and 9:05pm each weekday over a 33 week period. The bottom panel shows the first three weeks of the same time series. There is a strong daily seasonal pattern with frequency 169 (there are 169 5-minute intervals per day), and a weak weekly seasonal pattern with frequency 169 × 5 = 845. (Call volumes on Mondays tend to be higher than the rest of the week.) If a longer series of data were available, we may also have observed an annual seasonal pattern.

Source : 11.1 Complex seasonality

## Convert the univariate price to be OHLC price in `minutes` unit.
Y2015W1_min1 <- Y2015W1 %>% 
  convertOHLC(combine = TRUE, trade = FALSE, .unit = t.unit[2]) %>% 
  bind_rows #combined `ask/bid` price
Y2015W1_min1
## # A tibble: 7,200 x 9
##    index               BidOpen BidHigh BidLow BidClose AskOpen AskHigh AskLow
##    <dttm>                <dbl>   <dbl>  <dbl>    <dbl>   <dbl>   <dbl>  <dbl>
##  1 2015-01-05 00:01:00    120.    121.   120.     121.    121.    121.   121.
##  2 2015-01-05 00:02:00    121.    121.   120.     121.    121.    121.   121.
##  3 2015-01-05 00:03:00    121.    121.   121.     121.    121.    121.   121.
##  4 2015-01-05 00:04:00    121.    121.   121.     121.    121.    121.   121.
##  5 2015-01-05 00:05:00    121.    121.   120.     121.    121.    121.   121.
##  6 2015-01-05 00:06:00    121.    121.   120.     120.    121.    121.   121.
##  7 2015-01-05 00:07:00    120.    121.   120.     121.    121.    121.   120.
##  8 2015-01-05 00:08:00    121.    121.   121.     121.    121.    121.   121.
##  9 2015-01-05 00:09:00    121.    121.   121.     121.    121.    121.   121.
## 10 2015-01-05 00:10:00    121.    121.   121.     121.    121.    121.   121.
## # ... with 7,190 more rows, and 1 more variable: AskClose <dbl>
#suppressWarnings(Y2015W1 <- tbl %>% 
#       dplyr::select(date, close) %>% tk_xts %>% 
#       auto.arima(seasonal = FALSE))

## Count the observation in order to model seasonal frequency model.
Y2015W1_min1 %>% 
  dplyr::select(index) %>% 
  ddply(.(date(index)), summarise, n = length(index)) %>% 
  as_tibble
## # A tibble: 6 x 2
##   `date(index)`     n
##   <date>        <int>
## 1 2015-01-05     1439
## 2 2015-01-06     1440
## 3 2015-01-07     1440
## 4 2015-01-08     1440
## 5 2015-01-09     1440
## 6 2015-01-10        1

Kindly refer to section Seasonal Data or Seasonal periods to know the seasonality dataset. High Frequency GARCH: The multiplicative component GARCH (mcsGARCH) model use the dataset start from 00:01:00 but not 00:00:00, therefore above dataset shows the last observation will be the start of next day.

# tsz <- llply(fls[[7]], function(x) {
#     y <- read_rds(x) %>% 
#       convertOHLC(combine = TRUE, trade = FALSE, .unit = t.unit[2]) %>% 
#         bind_rows %>% 
#         dplyr::filter(index == head(index, 1) | 
#                       index == tail(index, 1)) %>% 
#       mutate(diff = difftime(index, lag(index, 1), units = 'mins'))
#     }) %>% bind_rows %>% as_tibble %>% arrange(index)
# saveRDS(tsz, 'C:/Users/scibr/Documents/GitHub/scibrokes/real-time-fxcm/data/USDJPY/tsz.rds')

## The daylight saving convertion in not tally.
tsz <- read_rds(paste0(dtr1s, '/tsz.rds')) %>% 
  dplyr::filter(index >= ymd_hms('2015-01-05 00:00:00', tz = 'Europe/Athens'))
tsz
## # A tibble: 368 x 10
##    index               AskOpen AskHigh AskLow AskClose BidOpen BidHigh BidLow
##    <dttm>                <dbl>   <dbl>  <dbl>    <dbl>   <dbl>   <dbl>  <dbl>
##  1 2015-01-05 00:01:00    121.    121.   121.     121.    120.    121.   120.
##  2 2015-01-10 00:00:00    119.    119.   119.     119.    118.    118.   118.
##  3 2015-01-12 00:01:00    118.    118.   118.     118.    118.    118.   118.
##  4 2015-01-16 23:57:00    117.    118.   117.     118.    117.    118.   117.
##  5 2015-01-19 00:01:00    117.    118.   117.     117.    117.    117.   117.
##  6 2015-01-23 23:59:00    118.    118.   118.     118.    118.    118.   118.
##  7 2015-01-26 00:01:00    118.    118.   118.     118.    118.    118.   117.
##  8 2015-01-30 23:59:00    118.    118.   118.     118.    117.    118.   117.
##  9 2015-02-02 00:01:00    117.    117.   117.     117.    117.    117.   117.
## 10 2015-02-07 00:00:00    119.    119.   119.     119.    119.    119.   119.
## # ... with 358 more rows, and 2 more variables: BidClose <dbl>, diff <drtn>
## count the frequency of weekly observation.
tsz %>% dplyr::count(diff) %>% 
  kable(caption = 'Count data point') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
  scroll_box(width = '100%', height = '400px')
Count data point
diff n
1228 mins 1
1276 mins 1
1657 mins 1
2407 mins 1
2449 mins 1
2650 mins 1
2834 mins 1
3777 mins 1
5251 mins 1
5395 mins 1
5495 mins 1
5521 mins 1
5522 mins 1
5620 mins 1
5638 mins 2
5763 mins 2
6355 mins 1
6831 mins 1
6896 mins 1
7180 mins 1
7181 mins 1
7187 mins 1
7190 mins 1
7192 mins 1
7193 mins 1
7194 mins 7
7195 mins 8
7196 mins 9
7197 mins 8
7198 mins 41
7199 mins 84
NA mins 184
## missing observation.
tsz %>% dplyr::filter(diff <= 6000)
## # A tibble: 18 x 10
##    index               AskOpen AskHigh AskLow AskClose BidOpen BidHigh BidLow
##    <dttm>                <dbl>   <dbl>  <dbl>    <dbl>   <dbl>   <dbl>  <dbl>
##  1 2015-12-24 20:02:00    120.    120.   120.     120.    120.    120.   120.
##  2 2015-12-31 20:03:00    120.    120.   120.     120.    120.    120.   120.
##  3 2016-02-03 14:58:00    119.    119.   119.     119.    119.    119.   119.
##  4 2016-04-14 15:34:00    109.    109.   109.     109.    109.    109.   109.
##  5 2016-04-19 23:15:00    109.    109.   109.     109.    109.    109.   109.
##  6 2016-05-03 16:08:00    106.    106.   106.     106.    106.    106.   106.
##  7 2016-11-17 21:41:00    110.    110.   110.     110.    110.    110.   110.
##  8 2016-12-30 23:59:00    117.    117.   117.     117.    117.    117.   117.
##  9 2017-01-06 23:59:00    117.    117.   117.     117.    117.    117.   117.
## 10 2017-04-17 20:31:00    109.    109.   109.     109.    109.    109.   109.
## 11 2017-04-25 16:53:00    111.    111.   111.     111.    111.    111.   111.
## 12 2017-05-15 21:18:00    114.    114.   114.     114.    114.    114.   114.
## 13 2017-05-23 20:12:00    112.    112.   112.     112.    112.    112.   112.
## 14 2017-06-29 19:37:00    112.    112.   112.     112.    112.    112.   112.
## 15 2017-08-08 03:39:00    111.    111.   111.     111.    111.    111.   111.
## 16 2017-12-29 23:58:00    113.    113.   113.     113.    113.    113.   113.
## 17 2018-01-06 01:00:00    113.    113.   113.     113.    113.    113.   113.
## 18 2018-01-06 01:00:00    113.    113.   113.     113.    113.    113.   113.
## # ... with 2 more variables: BidClose <dbl>, diff <drtn>
## https://stackoverflow.com/questions/34454947/why-is-this-xts-frequency-always-1
## https://www.stat.berkeley.edu/~s133/dates.html
## https://stackoverflow.com/questions/45070078/convert-forecast-time-produced-by-arima-into-standard-date-time
#How to extract below index to datetime
#Y2015W1 %>% tk_ts(end = c(1440, 7200), frequency = 1440) %>% attributes %>% .$index %>% as.POSIXct(tz = 'UTC', origin = '1970-01-01') %>% force_tz(tz = 'Europe/Athens')
Y2015W1_min1 %>% 
  tk_ts(end = c(3, 7200), frequency = 1440) %>% 
  .[,1:ncol(.)] %>% 
  head #1440 * 5 = 7200
## Time Series:
## Start = c(3, 1) 
## End = c(3, 6) 
## Frequency = 1440 
##          BidOpen BidHigh  BidLow BidClose AskOpen AskHigh  AskLow AskClose
## 3.000000 120.474 120.542 120.442  120.502 120.534 120.638 120.520  120.608
## 3.000694 120.524 120.570 120.484  120.538 120.592 120.671 120.566  120.610
## 3.001389 120.568 120.588 120.533  120.568 120.624 120.678 120.588  120.612
## 3.002083 120.570 120.606 120.508  120.539 120.614 120.708 120.566  120.668
## 3.002778 120.544 120.594 120.472  120.576 120.668 120.714 120.506  120.598
## 3.003472 120.572 120.576 120.492  120.497 120.598 120.629 120.506  120.605
Y2015W1_min1 %>% 
  head %>% 
  zooreg(frequency = 1440)
##      index               BidOpen BidHigh BidLow  BidClose AskOpen AskHigh
## 1(1) 2015-01-05 00:01:00 120.474 120.542 120.442 120.502  120.534 120.638
## 1(2) 2015-01-05 00:02:00 120.524 120.570 120.484 120.538  120.592 120.671
## 1(3) 2015-01-05 00:03:00 120.568 120.588 120.533 120.568  120.624 120.678
## 1(4) 2015-01-05 00:04:00 120.570 120.606 120.508 120.539  120.614 120.708
## 1(5) 2015-01-05 00:05:00 120.544 120.594 120.472 120.576  120.668 120.714
## 1(6) 2015-01-05 00:06:00 120.572 120.576 120.492 120.497  120.598 120.629
##      AskLow  AskClose
## 1(1) 120.520 120.608 
## 1(2) 120.566 120.610 
## 1(3) 120.588 120.612 
## 1(4) 120.566 120.668 
## 1(5) 120.506 120.598 
## 1(6) 120.506 120.605
#Y2015W1_min1 %>% tk_ts(end = c(1440, 7200), frequency = 1440) %>% index %>% as.POSIXct(tz = 'UTC', origin = '1970-01-01')

## https://stats.stackexchange.com/questions/144158/daily-time-series-analysis
## http://manishbarnwal.com/blog/2017/05/03/time_series_and_forecasting_using_R/
#How to extract below index to datetime
#Y2015W1_min1 %>% msts(seasonal.periods=c(1440, 7200)) %>% .[,1] %>% as.numeric %>% as.POSIXct(tz = 'UTC', origin = '1970-01-01') %>% force_tz(tz = 'Europe/Athens')
Y2015W1_min1 %>% 
  head %>% 
  msts(seasonal.periods=c(1440, 7200))
## Multi-Seasonal Time Series:
## Start: 1 1
## Seasonal Periods: 1440 7200
## Data:
##           index BidOpen BidHigh  BidLow BidClose AskOpen AskHigh  AskLow
## [1,] 1420383660 120.474 120.542 120.442  120.502 120.534 120.638 120.520
## [2,] 1420383720 120.524 120.570 120.484  120.538 120.592 120.671 120.566
## [3,] 1420383780 120.568 120.588 120.533  120.568 120.624 120.678 120.588
## [4,] 1420383840 120.570 120.606 120.508  120.539 120.614 120.708 120.566
## [5,] 1420383900 120.544 120.594 120.472  120.576 120.668 120.714 120.506
## [6,] 1420383960 120.572 120.576 120.492  120.497 120.598 120.629 120.506
##      AskClose
## [1,]  120.608
## [2,]  120.610
## [3,]  120.612
## [4,]  120.668
## [5,]  120.598
## [6,]  120.605

ts() only can build a year-month seasonal dataset, otherwise need to decimal numeric to figure out what date within a month accordingly. msts() will be more user friendly which is modelling intra-and-inter seasonal dataset. Now I convert all dataset again from UTC to UTC+2 to be a constant weekly seasonal dataset. Due to the trading day is 5 days and 2 rest days, therefore I set a weekly seasonal period instead of daily.

2018 Time Zones - UTC shows that has no change in No changes, UTC all of the period from 2010 to 2019.

From the Wikipedia UTC page: UTC does not change with a change of seasons, but local time or civil time may change if a time zone jurisdiction observes daylight saving time or summer time. For example, UTC is 5 hours ahead of local time on the east coast of the United States during winter, but 4 hours ahead during summer. In other words, when a time zone observes DST, its offset from UTC changes when there’s a DST transition, but that’s that time zone observing DST, not UTC. Without knowing much about PHP time zone handling, it seems strange to me that you can specify “with DST” or “without DST” in a conversion - the time zones themselves specify when DST kicks in… it shouldn’t have to be something you specify yourself.

Source : Does UTC observe daylight saving time?

Due to the UTC timezone has no daylight saving issue, therefore the initial trading time will be a problem where I need to cope with. Handling Data for Daylight-Saving and Non-Daylight-Saving for HFT provides the solution for the timezone issue.

## -------- eval=FALSE --------------
## Now I simply tidy all datasets and save it prior to start the statistical modelling.
llply(fls[[7]], function(x) {
    mbase <- read_rds(x) %>% as_tibble
    ## Convert the univariate price to be OHLC price in `minutes` unit.
    mbase %<>% convertOHLC(.unit = t.unit[2], combine = TRUE) %>% 
        bind_rows #combined `ask/bid` price
    
    y <- x %>% str_replace_all('.rds$', '_tick-to-min1.rds')
    
    saveRDS(mbase, y)
    cat(y, 'saved!\n')
    })

3.2 1 Minute Data

3.2.1 Get and Tidy Data

Due to fxcm/MarketData updated and provides 1 minute, 1 hour, 1 day datasets recently, here I directly download 1 minute dataset and tidy it.

time is based on EST, because our server is in New Jersey USA. it is 5:00PM at the end of the day, which is shown in GMT as 21:00 day light saving or 22:00 without day light saving.

Source : Inconsistency of trading date time #1

From above quote, we can know even the EST converted to UTC will not be 00:00:00, therefore I refer to Handling data on the days when we switch to daylight savings time and back in R as my solution as UTC+2 (daylight saving UTC+3) will get the desired result.

cr_code <- c('EURUSD=X', 'GBPUSD=X', 'CHF=X', 'CAD=X', 'JPY=X')
names(cr_code) <- c('EURUSD', 'GBPUSD', 'USDCHF', 'USDCAD', 'USDJPY')

fls1 <- llply(names(cr_code), function(x) {
    fls <- list.files(paste0(dtr1, x), pattern = '^Y[0-9]{4}W[0-9]{1,2}_m1.rds$')
    if (length(fls) > 0) paste0(dtr1, x, '/', fls)
  })
names(fls1) <- names(cr_code)

dtr1s <- paste0(dtr1, names(fls1[length(fls1)]))
fs1 <- list.files(dtr1s, pattern = '^Y[0-9]{4}W[0-9]{1,2}_m1.rds$') %>% 
  str_replace_all('.rds', '')

## Read raw dataset.
# eval(parse(text = paste0(fs, "<- read_rds('", fls[[7]], "')")))
## Read raw dataset.
eval(parse(text = paste0(fs1[1], "<- read_rds('", fls1[[5]][1], "') %>% as_tibble")))

## raw dataset
Y2015W1_m1
## # A tibble: 7,200 x 9
##    DateTime      BidOpen BidHigh BidLow BidClose AskOpen AskHigh AskLow AskClose
##    <fct>           <dbl>   <dbl>  <dbl>    <dbl>   <dbl>   <dbl>  <dbl>    <dbl>
##  1 01/04/2015 2~    120.    121.   120.     121.    121.    121.   121.     121.
##  2 01/04/2015 2~    121.    121.   120.     121.    121.    121.   121.     121.
##  3 01/04/2015 2~    121.    121.   121.     121.    121.    121.   121.     121.
##  4 01/04/2015 2~    121.    121.   121.     121.    121.    121.   121.     121.
##  5 01/04/2015 2~    121.    121.   120.     121.    121.    121.   121.     121.
##  6 01/04/2015 2~    121.    121.   120.     120.    121.    121.   121.     121.
##  7 01/04/2015 2~    120.    121.   120.     121.    121.    121.   120.     121.
##  8 01/04/2015 2~    121.    121.   121.     121.    121.    121.   121.     121.
##  9 01/04/2015 2~    121.    121.   121.     121.    121.    121.   121.     121.
## 10 01/04/2015 2~    121.    121.   121.     121.    121.    121.   121.     121.
## # ... with 7,190 more rows

Now I try to validate the daylight saving date.

# tsz2 <- llply(fls1[[5]], function(x) {
#    y <- read_rds(x) %>% dplyr::filter(DateTime == head(DateTime, 1)|
#                                      DateTime == tail(DateTime, 1)) %>% 
#        mutate(DateTime = DateTime %>% mdy_hms %>% 
#                 .POSIXct(tz = 'Europe/Athens'), 
#               diff = difftime(DateTime, lag(DateTime, 1), units = 'mins'))
#    
#    nch <- y$DateTime[1] %>% substr(nchar(.)+2, nchar(.)+3)
#    y %<>% mutate(
#        nch = nch, DateTime = if_else(
#          nch == '23', DateTime + hours(1), DateTime)) %>% 
#        dplyr::select(-nch)
#    }) %>% bind_rows %>% as_tibble %>% arrange(DateTime)
# saveRDS(tsz2, 'C:/Users/scibr/Documents/GitHub/scibrokes/real-time-fxcm/data/USDJPY/tsz2.rds')

## The daylight saving convertion in not tally.
tsz2 <- read_rds(paste0(dtr1s, '/tsz2.rds')) %>% 
  dplyr::rename(index = DateTime) %>% 
  dplyr::filter(index >= ymd_hms('2015-01-05 00:01:00', tz = 'Europe/Athens'))
tsz2
## # A tibble: 365 x 10
##    index               BidOpen BidHigh BidLow BidClose AskOpen AskHigh AskLow
##    <dttm>                <dbl>   <dbl>  <dbl>    <dbl>   <dbl>   <dbl>  <dbl>
##  1 2015-01-09 23:59:00    119.    119.   118.     118.    119.    119.   119.
##  2 2015-01-12 00:00:00    118.    118.   118.     118.    118.    118.   118.
##  3 2015-01-16 23:56:00    117.    118.   117.     118.    117.    118.   117.
##  4 2015-01-19 00:00:00    117.    117.   117.     117.    117.    118.   117.
##  5 2015-01-23 23:58:00    118.    118.   118.     118.    118.    118.   118.
##  6 2015-01-26 00:00:00    118.    118.   117.     118.    118.    118.   118.
##  7 2015-01-30 23:58:00    117.    118.   117.     118.    118.    118.   118.
##  8 2015-02-02 00:00:00    117.    117.   117.     117.    117.    117.   117.
##  9 2015-02-06 23:59:00    119.    119.   119.     119.    119.    119.   119.
## 10 2015-02-09 00:00:00    119.    119.   119      119.    119.    119.   119.
## # ... with 355 more rows, and 2 more variables: AskClose <dbl>, diff <drtn>
## count the frequency of weekly observation.
tsz2 %>% dplyr::count(diff) %>% 
  kable(caption = 'Count data point') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
  scroll_box(width = '100%', height = '400px')
Count data point
diff n
5395 mins 1
5521 mins 1
5522 mins 1
5638 mins 2
5759 mins 1
7180 mins 1
7187 mins 1
7190 mins 1
7192 mins 1
7193 mins 1
7194 mins 7
7195 mins 10
7196 mins 13
7197 mins 10
7198 mins 47
7199 mins 85
NA mins 182
## missing observation.
tsz2 %>% dplyr::filter(diff <= 6000)
## # A tibble: 6 x 10
##   index               BidOpen BidHigh BidLow BidClose AskOpen AskHigh AskLow
##   <dttm>                <dbl>   <dbl>  <dbl>    <dbl>   <dbl>   <dbl>  <dbl>
## 1 2015-12-24 20:01:00    120.    120.   120.     120.    120.    120.   120.
## 2 2015-12-31 20:02:00    120.    120.   120.     120.    120.    120.   120.
## 3 2016-12-30 23:58:00    117.    117.   117.     117.    117.    117.   117.
## 4 2017-01-06 23:58:00    117.    117.   117.     117.    117.    117.   117.
## 5 2017-12-29 23:57:00    113.    113.   113.     113.    113.    113.   113.
## 6 2018-01-05 23:59:00    113.    113.   113.     113.    113.    113.   113.
## # ... with 2 more variables: AskClose <dbl>, diff <drtn>

From above tables, we can know the daylight saving detection and datetime auto convertion is not tally. Here I united all intial observation started from 00:01:00.

3.3 Completion of Data

3.3.1 Data Selection

binary.com 面试试题 I - 单变量数据缺失值管理 and binary.com面试试题 I - 单变量数据缺失值管理 II compares the missing values dataset and refill the missing value with imputeTS::na.seadec():

  • interpolation
  • kalman
  • locf
  • ma
  • mean
  • random

The papers concludes that the imputeTS::na.seadec(algorithm = 'interpolation') or imputeTS::na.seadec(algorithm = 'kalman') repaired dataset no matter how much of portion of missing value is workable since the MSE and bias is very low. The Amelia::amelia is accurate and the bias and imprecision is small compare to imputeTS::sea.dec when the portion of missing value is small. The papers compare tick-data-to-1min-data and also 1min-data where both datasets gather from FXCM. It is very weird that the tidyr::fill and na.locf both are not too accurate. However, in this paper I use tidy::fill() method to fill the missing value, it will similar with kalman filter method since it will filled up the missing value ascending to fill up with direction down until the bottom of the dataset and then fill up with direction up by descending to fill up initial missing value or top. It will not occured standard error bias like open or close price higher than highest price or lower than lowest price. Moreover, the filled price will not bias a lot from the trend as time goes by.

## tick-data to minute 1 dataset
#tsz <- read_rds('C:/Users/scibr/Documents/GitHub/scibrokes/real-time-fxcm/data/USDJPY/tsz.rds')
tsz %>% dplyr::count(diff) %>% 
  kable(caption = 'Count data point') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
  scroll_box(width = '100%', height = '400px')
Count data point
diff n
1228 mins 1
1276 mins 1
1657 mins 1
2407 mins 1
2449 mins 1
2650 mins 1
2834 mins 1
3777 mins 1
5251 mins 1
5395 mins 1
5495 mins 1
5521 mins 1
5522 mins 1
5620 mins 1
5638 mins 2
5763 mins 2
6355 mins 1
6831 mins 1
6896 mins 1
7180 mins 1
7181 mins 1
7187 mins 1
7190 mins 1
7192 mins 1
7193 mins 1
7194 mins 7
7195 mins 8
7196 mins 9
7197 mins 8
7198 mins 41
7199 mins 84
NA mins 184
## minute 1 dataset
#tsz2 <- read_rds('C:/Users/scibr/Documents/GitHub/scibrokes/real-time-fxcm/data/USDJPY/tsz2.rds')
tsz2 %>% dplyr::count(diff) %>% 
  kable(caption = 'Count data point') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
  scroll_box(width = '100%', height = '400px')
Count data point
diff n
5395 mins 1
5521 mins 1
5522 mins 1
5638 mins 2
5759 mins 1
7180 mins 1
7187 mins 1
7190 mins 1
7192 mins 1
7193 mins 1
7194 mins 7
7195 mins 10
7196 mins 13
7197 mins 10
7198 mins 47
7199 mins 85
NA mins 182

Above tables show both datasets are incompleted. However, when I tried to check the Y2017W20 and Y2017W20_m1, the tick-dataset only start from 2017-05-15 until 2017-05-17 but the m1-dataset from 2017-05-15 until 2017-05-19. Kindly refer to below comparison.

mean(tsz$diff, na.rm=TRUE)
## Time difference of 6886.853 mins
mean(tsz2$diff, na.rm=TRUE)
## Time difference of 7144.601 mins

From above comparison, we know the dataset of 1min is better compelete than tick-to-1min dataset.

#left_join(tsz[c(1, ncol(tsz))], tsz2[c(1, ncol(tsz2))])
right_join(tsz[c(1, ncol(tsz))], tsz2[c(1, ncol(tsz2))])
## # A tibble: 365 x 2
##    index               diff     
##    <dttm>              <drtn>   
##  1 2015-01-09 23:59:00 7199 mins
##  2 2015-01-12 00:00:00   NA mins
##  3 2015-01-16 23:56:00 7196 mins
##  4 2015-01-19 00:00:00   NA mins
##  5 2015-01-23 23:58:00 7198 mins
##  6 2015-01-26 00:00:00   NA mins
##  7 2015-01-30 23:58:00 7198 mins
##  8 2015-02-02 00:00:00   NA mins
##  9 2015-02-06 23:59:00 7199 mins
## 10 2015-02-09 00:00:00   NA mins
## # ... with 355 more rows

Here I compare the mean and get to know the downloaded min1 dataset from FXCM is better than downloaded tick-dataset (converted to min1) from FXCM.

# -------- eval=FALSE -----------
## tick-data to min-1 dataset
data_tm1 <- llply(fls[[7]], function(x) {
    y <- read_rds(x) %>% 
      convertOHLC(combine = TRUE)
    
    yw <- x %>% 
      str_extract_all('Y[0-9]{4}W[0-9]{1,2}') %>% 
      str_split_fixed('[A-Z]{1}', 3) %>% 
      .[,-1]
    y %<>% mutate(
      year = as.numeric(yw[1]), week = as.numeric(yw[2]), .)
    }) %>% 
  bind_rows %>% 
  as_tibble %>% 
  arrange(index)


## min-1 dataset
data_m1 <- llply(fls1[[5]], function(x) {
    y <- read_rds(x) %>% 
      dplyr::rename(index = DateTime) %>% 
      mutate(index = index %>% mdy_hms %>% 
               .POSIXct(tz = 'Europe/Athens') %>% 
               force_tz())
    
    yw <- x %>% str_extract_all('Y[0-9]{4}W[0-9]{1,2}') %>% 
      str_split_fixed('[A-Z]{1}', 3) %>% .[,-1]
    
    nch <- y$index[1] %>% substr(nchar(.)+2, nchar(.)+3)
    y %<>% mutate(
      year = as.numeric(yw[1]), week = as.numeric(yw[2]), 
      nch = nch, index = if_else(
        nch == '23', index + hours(1), index)) %>% 
      dplyr::select(-nch)
    }) %>% 
  bind_rows %>% 
  as_tibble %>% 
  arrange(index)
# -------- eval=FALSE -----------
#dtm <- seq(ymd_hms('2015-01-01 00:00:00'), ymd_hms('2017-08-31 00:00:00'), by = 'minutes')
#dtm <- seq(from = ymd('2015-01-05'), to = ymd('2018-07-07'), by = 'weeks')
dtm <- data_tm1 %>% 
  dplyr::select(index, year ,week) %>% 
  mutate(index = date(index)) %>% 
  ddply(.(year, week), head, 1) %>% 
  .[-nrow(.),]

## create a seq of datetime to complete the  data point.
dttm <- llply(1:nrow(dtm), function(i) {
  x1 <- dtm$index[i] %>% 
    as.POSIXct %>% 
    with_tz(tz = 'UTC') %>% 
    force_tz()
  
  #x2 <- x1 + days(4) + hours(23) + minutes(59)
  x2 <- x1 + days(5)
  
  data_frame(index = seq.POSIXt(from = x1 + minutes(1), to = x2, by = '1 min'), 
             year = dtm[i,2], week = dtm[i,3])
  }) %>% 
  bind_rows %>% 
  as_tibble

Above chunk created a sequence of datetime.

## merge dataset
data_m1 <- left_join(dttm, data_m1) %>% 
  as_tibble %>% 
  unique %>% 
  arrange(index)

data_tm1 <- left_join(dttm, data_tm1) %>% 
  as_tibble %>% 
  unique %>% 
  arrange(index)

## https://stackoverflow.com/questions/43212308/na-locf-using-group-by-from-dplyr
## https://stackoverflow.com/questions/233401., eval.expr = TRUE) : 
  Scanner error: mapping values50/replace-missing-values-na-with-most-recent-non-na-by-group
## https://stackoverflow.com/questions/40040834/replace-na-with-previous-or-next-value-by-group-using-dplyr/40041172
## https://stackoverflow.com/questions/47242643/na-at-the-end-of-column-using-na-locf-function
## https://stackoverflow.com/questions/49578085/na-locf-function-is-changing-data-frame-values-from-int-to-char-in-r
## https://stackoverflow.com/questions/13616965/how-to-fill-nas-with-locf-by-factors-in-data-frame-split-by-country
## https://stackoverflow.com/questions/23340150/replace-missing-values-na-with-most-recent-non-na-by-group

# data_m1 %>% 
#     group_by(index, week) %>% 
#     mutate_all(funs(na.locf(., na.rm = FALSE)))

# data_m1 %>% split(data_m1$index) %>% 
#   llply(function(x) {
#     na.locf(na.locf(x), fromLast = TRUE)
#   }) %>% do.call(rbind, .)

# data_m1 %<>% ddply(.(index, week), na_locf) %>% as_tibble
#> data_m1 %>% anyNA
#[1] FALSE

data_m1 %<>% 
  ddply(.(year, week), function(x) {
       x %>% fill(year, week, BidOpen, BidHigh, BidLow, BidClose, 
                  AskOpen, AskHigh, AskLow, AskClose) %>% #default direction down
             fill(year, week, BidOpen, BidHigh, BidLow, BidClose, 
                  AskOpen, AskHigh, AskLow, AskClose, .direction = 'up')
    }) %>% 
  as_tibble

data_tm1 %<>% 
  ddply(.(year, week), function(x) {
       x %>% fill(year, week, BidOpen, BidHigh, BidLow, BidClose, 
                  AskOpen, AskHigh, AskLow, AskClose) %>% #default direction down
             fill(year, week, BidOpen, BidHigh, BidLow, BidClose, 
                  AskOpen, AskHigh, AskLow, AskClose, .direction = 'up')
    }) %>% 
  as_tibble
#> data_m1 %>% anyNA
#[1] TRUE
#> data_m1 %>% filter_all(any_vars(is.na(.)))
## A tibble: 7,200 x 11
#   index                year  week BidOpen BidHigh BidLow BidClose AskOpen AskHigh AskLow AskClose
#   <dttm>              <dbl> <dbl>   <dbl>   <dbl>  <dbl>    <dbl>   <dbl>   <dbl>  <dbl>    <dbl>
# 1 2018-01-02 00:01:00  2017    53      NA      NA     NA       NA      NA      NA     NA       NA
# 2 2018-01-02 00:02:00  2017    53      NA      NA     NA       NA      NA      NA     NA       NA
# 3 2018-01-02 00:03:00  2017    53      NA      NA     NA       NA      NA      NA     NA       NA
# 4 2018-01-02 00:04:00  2017    53      NA      NA     NA       NA      NA      NA     NA       NA
# 5 2018-01-02 00:05:00  2017    53      NA      NA     NA       NA      NA      NA     NA       NA
# 6 2018-01-02 00:06:00  2017    53      NA      NA     NA       NA      NA      NA     NA       NA
# 7 2018-01-02 00:07:00  2017    53      NA      NA     NA       NA      NA      NA     NA       NA
# 8 2018-01-02 00:08:00  2017    53      NA      NA     NA       NA      NA      NA     NA       NA
# 9 2018-01-02 00:09:00  2017    53      NA      NA     NA       NA      NA      NA     NA       NA
#10 2018-01-02 00:10:00  2017    53      NA      NA     NA       NA      NA      NA     NA       NA
## ... with 7,190 more rows

#> data_tm1 %>% anyNA
#[1] FALSE
#> data_tm1 %>% filter_all(any_vars(is.na(.)))
## A tibble: 0 x 11
## ... with 11 variables: index <dttm>, year <dbl>, week <dbl>, AskOpen <dbl>, AskHigh <dbl>, AskLow <dbl>,
##   AskClose <dbl>, BidOpen <dbl>, BidHigh <dbl>, BidLow <dbl>, BidClose <dbl>

saveRDS(data_m1, paste0(dtr1, '/data_m1.rds'))
saveRDS(data_tm1, paste0(dtr1, '/data_tm1.rds'))

I don’t use the data.table and feather because of the storage concerns. Kindly refer to [问答] 对大数据如何用R高效处理[问答] 对大数据如何用R高效处理.

Finally, I filled-up the NA section of data_m1 and data_tm1 and eventually filled up by tidyr::fill function.

3.3.2 Read Data

Due to the files preload all before simulate the statistical modelling will occupy the space. Here I directly read the files and simulate the algorithmic prediction in following sections.

rm(list = ls()[grep('i|j|tz|nch|yw|dtm|dttm|form|data|Y2015W|tsz|tsz2|dc', ls())])

cr_code <- c('AUDUSD=X', 'EURUSD=X', 'GBPUSD=X', 'CHF=X', 'CAD=X', 'CNY=X', 'JPY=X')

names(cr_code) <- c('AUDUSD', 'EURUSD', 'GBPUSD', 'USDCHF', 'USDCAD', 'USDCNY', 'USDJPY')

data_m1 <- read_rds(paste0(dtr1s, '/data_m1.rds'))

tb1 <- data_m1 %>% ddply(.(year, week), head, 1) %>% 
  kbl('html', caption = 'Weekly Initial Data Point', escape = FALSE) %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
  scroll_box(width = '100%', height = '400px')

tb1
Weekly Initial Data Point
index year week BidOpen BidHigh BidLow BidClose AskOpen AskHigh AskLow AskClose
2015-01-05 00:01:00 2015 1 120.502 120.570 120.484 120.538 120.608 120.671 120.566 120.610
2015-01-12 00:01:00 2015 2 118.222 118.280 118.214 118.262 118.276 118.312 118.258 118.282
2015-01-19 00:01:00 2015 3 117.442 117.442 117.402 117.432 117.478 117.550 117.478 117.512
2015-01-26 00:01:00 2015 4 117.500 117.504 117.467 117.482 117.508 117.524 117.502 117.507
2015-02-02 00:01:00 2015 5 116.979 117.048 116.971 117.046 117.011 117.067 116.983 117.065
2015-02-09 00:01:00 2015 6 119.028 119.046 119.000 119.046 119.081 119.150 119.042 119.052
2015-02-16 00:01:00 2015 7 118.562 118.628 118.544 118.628 118.587 118.649 118.548 118.646
2015-02-23 00:01:00 2015 8 119.094 119.094 119.061 119.061 119.149 119.149 119.109 119.109
2015-03-02 00:01:00 2015 9 119.688 119.716 119.673 119.716 119.760 119.764 119.714 119.748
2015-03-09 00:01:00 2015 10 120.800 120.836 120.800 120.836 120.920 120.920 120.889 120.889
2015-03-16 00:01:00 2015 11 121.374 121.382 121.346 121.346 121.430 121.436 121.410 121.410
2015-03-23 00:01:00 2015 12 119.884 119.894 119.868 119.890 119.900 119.902 119.897 119.898
2015-03-30 00:01:00 2015 13 119.216 119.220 119.203 119.203 119.247 119.253 119.230 119.230
2015-04-06 00:01:00 2015 14 118.845 118.845 118.839 118.839 118.915 118.951 118.915 118.943
2015-04-13 00:01:00 2015 15 120.299 120.311 120.299 120.311 120.385 120.386 120.368 120.368
2015-04-20 00:01:00 2015 16 118.985 118.993 118.985 118.993 119.014 119.047 119.014 119.047
2015-04-27 00:01:00 2015 17 118.864 118.877 118.864 118.876 118.906 118.906 118.903 118.903
2015-05-04 00:01:00 2015 18 120.227 120.227 120.226 120.226 120.242 120.242 120.242 120.242
2015-05-11 00:01:00 2015 19 119.652 119.688 119.644 119.658 119.684 119.731 119.676 119.719
2015-05-18 00:01:00 2015 20 119.214 119.255 119.214 119.255 119.308 119.314 119.308 119.312
2015-05-25 00:01:00 2015 21 121.494 121.494 121.488 121.488 121.516 121.516 121.512 121.512
2015-06-01 00:01:00 2015 22 124.076 124.084 124.072 124.072 124.100 124.106 124.094 124.096
2015-06-08 00:01:00 2015 23 125.578 125.588 125.566 125.568 125.598 125.610 125.590 125.590
2015-06-15 00:01:00 2015 24 123.174 123.174 123.130 123.159 123.276 123.276 123.186 123.189
2015-06-22 00:01:00 2015 25 122.955 122.957 122.922 122.922 122.968 122.968 122.936 122.936
2015-06-29 00:01:00 2015 26 122.728 122.736 122.667 122.707 122.740 122.806 122.692 122.740
2015-07-06 00:01:00 2015 27 121.968 122.004 121.951 121.986 121.992 122.128 121.978 122.002
2015-07-13 00:01:00 2015 28 122.218 122.224 122.178 122.204 122.332 122.332 122.206 122.286
2015-07-20 00:01:00 2015 29 124.044 124.044 124.036 124.036 124.058 124.058 124.048 124.048
2015-07-27 00:01:00 2015 30 123.728 123.760 123.726 123.760 123.800 123.830 123.770 123.830
2015-08-03 00:01:00 2015 31 123.850 123.860 123.850 123.860 123.904 123.906 123.904 123.906
2015-08-10 00:01:00 2015 32 124.140 124.140 124.127 124.127 124.204 124.204 124.204 124.204
2015-08-17 00:01:00 2015 33 124.228 124.268 124.228 124.255 124.356 124.372 124.352 124.363
2015-08-24 00:01:00 2015 34 121.882 121.894 121.882 121.890 121.902 121.920 121.902 121.918
2015-08-31 00:01:00 2015 35 121.576 121.622 121.576 121.616 121.682 121.686 121.624 121.632
2015-09-07 00:01:00 2015 36 118.864 118.906 118.864 118.874 118.918 118.926 118.914 118.918
2015-09-14 00:01:00 2015 37 120.488 120.489 120.472 120.472 120.602 120.603 120.596 120.596
2015-09-21 00:01:00 2015 38 120.104 120.112 120.102 120.102 120.136 120.144 120.134 120.136
2015-09-28 00:01:00 2015 39 120.510 120.510 120.502 120.502 120.536 120.543 120.536 120.543
2015-10-05 00:01:00 2015 40 119.982 119.987 119.968 119.986 120.008 120.072 120.008 120.070
2015-10-12 00:01:00 2015 41 120.166 120.166 120.162 120.164 120.199 120.202 120.194 120.199
2015-10-19 00:01:00 2015 42 119.351 119.351 119.346 119.346 119.429 119.434 119.429 119.434
2015-10-26 00:01:00 2015 43 121.450 121.468 121.448 121.454 121.518 121.520 121.470 121.470
2015-11-02 00:01:00 2015 44 120.450 120.462 120.392 120.396 120.479 120.483 120.402 120.430
2015-11-09 00:01:00 2015 45 123.254 123.302 123.254 123.302 123.362 123.362 123.319 123.319
2015-11-16 00:01:00 2015 46 122.286 122.310 122.280 122.293 122.299 122.350 122.295 122.301
2015-11-23 00:01:00 2015 47 122.801 122.821 122.801 122.816 122.920 122.925 122.919 122.924
2015-11-30 00:01:00 2015 48 122.810 122.811 122.810 122.811 122.829 122.830 122.829 122.830
2015-12-07 00:01:00 2015 49 123.191 123.191 123.190 123.190 123.240 123.240 123.239 123.239
2015-12-14 00:01:00 2015 50 121.138 121.147 120.965 121.100 121.158 121.158 121.045 121.110
2015-12-21 00:01:00 2015 51 121.226 121.226 121.226 121.226 121.258 121.260 121.258 121.260
2015-12-28 00:01:00 2015 52 120.230 120.270 120.216 120.223 120.328 120.330 120.260 120.328
2016-01-04 00:01:00 2016 1 120.199 120.205 120.199 120.205 120.241 120.241 120.234 120.235
2016-01-11 00:01:00 2016 2 117.139 117.164 117.131 117.164 117.158 117.228 117.145 117.200
2016-01-18 00:01:00 2016 3 116.699 116.834 116.682 116.828 116.752 116.882 116.750 116.872
2016-01-25 00:01:00 2016 4 118.620 118.689 118.620 118.689 118.701 118.780 118.700 118.707
2016-02-01 00:01:00 2016 5 121.298 121.298 121.198 121.258 121.325 121.325 121.244 121.277
2016-02-08 00:01:00 2016 6 116.779 116.799 116.779 116.799 116.877 116.899 116.877 116.899
2016-02-15 00:01:00 2016 7 113.382 113.382 113.376 113.382 113.418 113.419 113.418 113.418
2016-02-22 00:01:00 2016 8 112.558 112.560 112.536 112.536 112.618 112.624 112.616 112.624
2016-02-29 00:01:00 2016 9 113.942 113.948 113.940 113.946 113.994 113.999 113.992 113.998
2016-03-07 00:01:00 2016 10 113.918 113.918 113.913 113.913 113.982 113.982 113.982 113.982
2016-03-14 00:01:00 2016 11 113.935 113.936 113.924 113.924 113.962 113.968 113.956 113.958
2016-03-21 00:01:00 2016 12 111.518 111.518 111.512 111.512 111.612 111.612 111.602 111.602
2016-03-28 00:01:00 2016 13 113.156 113.156 113.149 113.149 113.234 113.240 113.234 113.240
2016-04-04 00:01:00 2016 14 111.590 111.594 111.590 111.590 111.658 111.662 111.658 111.660
2016-04-11 00:01:00 2016 15 107.932 107.992 107.932 107.992 108.006 108.066 108.006 108.020
2016-04-18 00:01:00 2016 16 108.173 108.220 108.173 108.188 108.252 108.284 108.252 108.274
2016-04-25 00:01:00 2016 17 111.846 111.848 111.844 111.848 111.882 111.892 111.882 111.892
2016-05-02 00:01:00 2016 18 106.230 106.254 106.216 106.244 106.274 106.310 106.273 106.280
2016-05-09 00:01:00 2016 19 107.068 107.068 107.066 107.067 107.106 107.108 107.106 107.108
2016-05-16 00:01:00 2016 20 108.592 108.595 108.589 108.595 108.654 108.674 108.654 108.670
2016-05-23 00:01:00 2016 21 110.138 110.138 110.134 110.136 110.176 110.176 110.172 110.172
2016-05-30 00:01:00 2016 22 110.414 110.428 110.410 110.428 110.432 110.456 110.432 110.451
2016-06-06 00:01:00 2016 23 106.549 106.555 106.547 106.555 106.575 106.575 106.573 106.575
2016-06-13 00:01:00 2016 24 106.800 106.833 106.796 106.812 106.890 106.892 106.884 106.884
2016-06-20 00:01:00 2016 25 104.681 104.692 104.657 104.671 104.739 104.744 104.723 104.743
2016-06-27 00:01:00 2016 26 101.519 101.521 101.510 101.519 101.539 101.550 101.527 101.546
2016-07-04 00:01:00 2016 27 102.594 102.598 102.594 102.598 102.636 102.647 102.634 102.647
2016-07-11 00:01:00 2016 28 100.589 100.590 100.589 100.590 100.653 100.653 100.653 100.653
2016-07-18 00:01:00 2016 29 105.333 105.342 105.331 105.342 105.369 105.369 105.368 105.368
2016-07-25 00:01:00 2016 30 106.116 106.129 106.089 106.089 106.180 106.186 106.175 106.176
2016-08-01 00:01:00 2016 31 102.284 102.284 102.205 102.234 102.376 102.376 102.274 102.284
2016-08-08 00:01:00 2016 32 101.937 101.946 101.937 101.944 101.996 102.012 101.964 102.012
2016-08-15 00:01:00 2016 33 101.115 101.124 101.115 101.124 101.157 101.206 101.157 101.206
2016-08-22 00:01:00 2016 34 100.748 100.748 100.746 100.748 100.811 100.811 100.784 100.784
2016-08-29 00:01:00 2016 35 102.039 102.096 102.026 102.076 102.116 102.122 102.052 102.102
2016-09-05 00:01:00 2016 36 104.078 104.084 104.078 104.078 104.146 104.146 104.146 104.146
2016-09-12 00:01:00 2016 37 102.552 102.588 102.552 102.571 102.650 102.651 102.650 102.651
2016-09-19 00:01:00 2016 38 102.148 102.178 102.148 102.178 102.246 102.266 102.204 102.220
2016-09-26 00:01:00 2016 39 101.029 101.059 101.029 101.038 101.079 101.135 101.079 101.132
2016-10-03 00:01:00 2016 40 101.196 101.198 101.194 101.198 101.276 101.284 101.276 101.284
2016-10-10 00:01:00 2016 41 103.292 103.296 103.242 103.252 103.374 103.374 103.299 103.299
2016-10-17 00:01:00 2016 42 104.327 104.327 104.317 104.326 104.340 104.344 104.340 104.340
2016-10-24 00:01:00 2016 43 103.816 103.820 103.816 103.820 103.873 103.873 103.873 103.873
2016-10-31 00:01:00 2016 44 104.404 104.412 104.401 104.411 104.502 104.502 104.489 104.493
2016-11-07 00:01:00 2016 45 104.033 104.033 103.769 103.769 104.117 104.117 103.829 103.829
2016-11-14 00:01:00 2016 46 106.848 106.848 106.767 106.812 106.880 106.880 106.792 106.822
2016-11-21 00:01:00 2016 47 110.898 110.980 110.898 110.958 110.982 110.995 110.980 110.986
2016-11-28 00:01:00 2016 48 112.798 112.872 112.798 112.872 112.872 112.902 112.872 112.902
2016-12-05 00:01:00 2016 49 113.223 113.248 113.176 113.182 113.372 113.372 113.186 113.196
2016-12-12 00:01:00 2016 50 115.403 115.412 115.403 115.408 115.452 115.452 115.437 115.452
2016-12-19 00:01:00 2016 51 117.948 117.948 117.948 117.948 117.972 117.972 117.956 117.972
2016-12-27 00:01:00 2016 52 117.242 117.242 117.189 117.195 117.322 117.322 117.195 117.198
2017-01-03 00:01:00 2017 1 116.978 117.523 116.978 117.454 117.076 117.528 117.076 117.453
2017-01-09 00:01:00 2017 2 117.009 117.009 117.002 117.002 117.031 117.031 117.012 117.012
2017-01-16 00:01:00 2017 3 114.299 114.378 114.299 114.309 114.381 114.392 114.381 114.391
2017-01-23 00:01:00 2017 4 114.354 114.364 114.338 114.348 114.400 114.430 114.392 114.420
2017-01-30 00:01:00 2017 5 114.760 114.800 114.760 114.784 114.790 114.820 114.784 114.820
2017-02-06 00:01:00 2017 6 112.442 112.455 112.440 112.444 112.520 112.520 112.480 112.480
2017-02-13 00:01:00 2017 7 113.545 113.545 113.530 113.530 113.625 113.625 113.625 113.625
2017-02-20 00:01:00 2017 8 112.864 112.882 112.864 112.879 112.903 112.908 112.903 112.908
2017-02-27 00:01:00 2017 9 112.108 112.125 112.108 112.125 112.192 112.205 112.192 112.204
2017-03-06 00:01:00 2017 10 113.855 113.894 113.855 113.894 113.903 113.916 113.903 113.913
2017-03-13 00:01:00 2017 11 114.725 114.725 114.689 114.707 114.784 114.787 114.743 114.784
2017-03-20 00:01:00 2017 12 112.656 112.681 112.656 112.673 112.749 112.757 112.749 112.757
2017-03-27 00:01:00 2017 13 110.861 110.893 110.815 110.893 110.917 110.975 110.898 110.935
2017-04-03 00:01:00 2017 14 111.414 111.414 111.329 111.329 111.503 111.503 111.418 111.418
2017-04-10 00:01:00 2017 15 111.029 111.066 111.015 111.018 111.118 111.118 111.081 111.081
2017-04-17 00:01:00 2017 16 108.691 108.741 108.691 108.741 108.790 108.830 108.790 108.830
2017-04-24 00:01:00 2017 17 110.518 110.518 110.394 110.457 110.729 110.729 110.502 110.516
2017-05-01 00:01:00 2017 18 111.240 111.330 111.240 111.330 111.334 111.394 111.334 111.389
2017-05-08 00:01:00 2017 19 112.931 112.949 112.922 112.946 113.004 113.022 112.980 112.984
2017-05-15 00:01:00 2017 20 113.124 113.171 113.124 113.170 113.205 113.205 113.194 113.194
2017-05-22 00:01:00 2017 21 110.985 111.050 110.985 111.047 111.084 111.084 111.069 111.069
2017-05-29 00:01:00 2017 22 111.178 111.210 111.178 111.210 111.277 111.309 111.277 111.309
2017-06-05 00:01:00 2017 23 110.352 110.391 110.352 110.391 110.396 110.483 110.396 110.480
2017-06-12 00:01:00 2017 24 110.309 110.309 110.291 110.304 110.342 110.342 110.333 110.333
2017-06-19 00:01:00 2017 25 110.881 110.881 110.878 110.878 110.945 110.945 110.922 110.924
2017-06-26 00:01:00 2017 26 111.186 111.186 111.178 111.184 111.256 111.256 111.235 111.235
2017-07-03 00:01:00 2017 27 112.098 112.125 112.085 112.125 112.122 112.179 112.122 112.176
2017-07-10 00:01:00 2017 28 113.863 113.899 113.863 113.899 113.897 113.918 113.897 113.918
2017-07-17 00:01:00 2017 29 112.452 112.480 112.452 112.480 112.485 112.515 112.485 112.504
2017-07-24 00:01:00 2017 30 111.106 111.106 111.097 111.106 111.138 111.138 111.133 111.133
2017-07-31 00:01:00 2017 31 110.653 110.653 110.636 110.636 110.677 110.677 110.668 110.668
2017-08-07 00:01:00 2017 32 110.697 110.702 110.686 110.702 110.727 110.745 110.726 110.738
2017-08-14 00:01:00 2017 33 109.153 109.153 109.153 109.153 109.187 109.187 109.184 109.184
2017-08-21 00:01:00 2017 34 109.313 109.346 109.313 109.346 109.347 109.377 109.347 109.377
2017-08-28 00:01:00 2017 35 109.154 109.176 109.154 109.176 109.223 109.223 109.206 109.206
2017-09-04 00:01:00 2017 36 109.532 109.556 109.528 109.532 109.558 109.592 109.554 109.566
2017-09-11 00:01:00 2017 37 108.196 108.196 108.188 108.190 108.212 108.246 108.206 108.230
2017-09-18 00:01:00 2017 38 111.042 111.060 111.040 111.060 111.094 111.094 111.094 111.094
2017-09-25 00:01:00 2017 39 112.146 112.161 112.146 112.148 112.202 112.202 112.178 112.182
2017-10-02 00:01:00 2017 40 112.538 112.538 112.538 112.538 112.606 112.608 112.606 112.608
2017-10-09 00:01:00 2017 41 112.570 112.570 112.550 112.569 112.622 112.622 112.600 112.600
2017-10-16 00:01:00 2017 42 111.748 111.786 111.748 111.784 111.782 111.806 111.782 111.800
2017-10-23 00:01:00 2017 43 113.868 113.872 113.844 113.846 113.896 113.896 113.878 113.878
2017-10-30 00:01:00 2017 44 113.718 113.723 113.718 113.723 113.746 113.746 113.741 113.741
2017-11-06 00:01:00 2017 45 114.001 114.015 114.001 114.015 114.049 114.049 114.035 114.048
2017-11-13 00:01:00 2017 46 113.492 113.538 113.492 113.494 113.572 113.574 113.544 113.546
2017-11-20 00:01:00 2017 47 112.120 112.120 112.119 112.119 112.168 112.168 112.167 112.167
2017-11-27 00:01:00 2017 48 111.500 111.501 111.500 111.500 111.548 111.549 111.548 111.548
2017-12-04 00:01:00 2017 49 112.776 112.778 112.707 112.726 112.792 112.800 112.750 112.774
2017-12-11 00:01:00 2017 50 113.526 113.528 113.526 113.528 113.566 113.566 113.562 113.562
2017-12-18 00:01:00 2017 51 112.714 112.717 112.714 112.717 112.734 112.734 112.734 112.734
2017-12-26 00:01:00 2017 52 113.265 113.287 113.265 113.287 113.343 113.343 113.287 113.289
2018-01-02 00:01:00 2017 53 NA NA NA NA NA NA NA NA
2018-01-02 00:01:00 2018 1 112.596 112.601 112.596 112.601 112.650 112.658 112.650 112.658
2018-01-08 00:01:00 2018 2 113.116 113.121 113.116 113.121 113.152 113.152 113.150 113.152
2018-01-15 00:01:00 2018 3 111.075 111.082 111.075 111.081 111.113 111.113 111.104 111.104
2018-01-22 00:01:00 2018 4 110.543 110.543 110.517 110.517 110.602 110.602 110.570 110.570
2018-01-29 00:01:00 2018 5 108.685 108.700 108.684 108.693 108.733 108.746 108.732 108.732
2018-02-05 00:01:00 2018 6 110.200 110.206 110.172 110.172 110.248 110.248 110.228 110.232
2018-02-12 00:01:00 2018 7 108.858 108.862 108.832 108.836 108.896 108.898 108.858 108.858
2018-02-19 00:01:00 2018 8 106.328 106.328 106.298 106.304 106.382 106.382 106.348 106.348
2018-02-26 00:01:00 2018 9 107.106 107.116 107.092 107.092 107.132 107.132 107.114 107.114
2018-03-05 00:01:00 2018 10 105.500 105.500 105.494 105.496 105.554 105.556 105.552 105.552
2018-03-12 00:01:00 2018 11 106.635 106.642 106.635 106.642 106.673 106.680 106.673 106.680
2018-03-19 00:01:00 2018 12 105.915 105.917 105.904 105.915 105.926 105.949 105.916 105.942
2018-03-26 00:01:00 2018 13 104.641 104.642 104.640 104.642 104.694 104.695 104.678 104.695
2018-04-02 00:01:00 2018 14 106.260 106.260 106.237 106.237 106.312 106.312 106.273 106.274
2018-04-09 00:01:00 2018 15 106.937 106.944 106.937 106.944 106.989 106.992 106.989 106.992
2018-04-16 00:01:00 2018 16 107.338 107.470 107.338 107.462 107.385 107.525 107.385 107.510
2018-04-23 00:01:00 2018 17 107.766 107.770 107.762 107.770 107.816 107.816 107.816 107.816
2018-04-30 00:01:00 2018 18 109.055 109.066 109.020 109.066 109.083 109.091 109.046 109.089
2018-05-07 00:01:00 2018 19 109.109 109.109 109.108 109.108 109.127 109.127 109.126 109.126
2018-05-14 00:01:00 2018 20 109.384 109.384 109.335 109.346 109.443 109.443 109.389 109.394
2018-05-21 00:01:00 2018 21 110.869 110.900 110.866 110.866 110.897 110.917 110.894 110.909
2018-05-28 00:01:00 2018 22 109.738 109.746 109.702 109.740 109.750 109.762 109.745 109.760
2018-06-04 00:01:00 2018 23 109.454 109.454 109.450 109.450 109.480 109.480 109.456 109.456
2018-06-11 00:01:00 2018 24 109.284 109.296 109.284 109.292 109.324 109.350 109.324 109.350
2018-06-18 00:01:00 2018 25 110.665 110.676 110.665 110.665 110.700 110.719 110.700 110.718
2018-06-25 00:01:00 2018 26 109.841 109.847 109.841 109.847 109.889 109.895 109.884 109.895
2018-07-02 00:01:00 2018 27 110.680 110.680 110.667 110.667 110.720 110.726 110.720 110.726
tb2 <- data_m1 %>% ddply(.(year, week), tail, 1) %>% 
  kbl('html', caption = 'Weekly Final Data Point', escape = FALSE) %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
  scroll_box(width = '100%', height = '400px')

tb2
Weekly Final Data Point
index year week BidOpen BidHigh BidLow BidClose AskOpen AskHigh AskLow AskClose
2015-01-10 2015 1 118.522 118.522 118.495 118.495 118.556 118.601 118.556 118.601
2015-01-17 2015 2 117.462 117.554 117.461 117.548 117.490 117.669 117.482 117.669
2015-01-24 2015 3 117.724 117.770 117.714 117.732 117.834 117.836 117.796 117.816
2015-01-31 2015 4 117.493 117.534 117.438 117.528 117.548 117.614 117.548 117.576
2015-02-07 2015 5 119.134 119.134 119.090 119.090 119.158 119.222 119.158 119.222
2015-02-14 2015 6 118.719 118.719 118.696 118.696 118.919 118.944 118.919 118.944
2015-02-21 2015 7 119.050 119.056 118.966 119.010 119.098 119.116 119.036 119.042
2015-02-28 2015 8 119.596 119.636 119.576 119.576 119.620 119.710 119.618 119.704
2015-03-07 2015 9 120.784 120.784 120.708 120.708 120.804 120.885 120.804 120.885
2015-03-14 2015 10 121.426 121.428 121.350 121.416 121.448 121.496 121.388 121.458
2015-03-21 2015 11 120.048 120.052 120.008 120.018 120.072 120.100 120.056 120.068
2015-03-28 2015 12 119.112 119.112 119.109 119.109 119.150 119.171 119.150 119.171
2015-04-04 2015 13 118.929 118.929 118.928 118.928 119.016 119.041 119.016 119.041
2015-04-11 2015 14 120.170 120.174 120.170 120.174 120.206 120.261 120.206 120.261
2015-04-18 2015 15 118.889 118.897 118.889 118.897 118.971 118.978 118.971 118.978
2015-04-25 2015 16 118.906 118.930 118.906 118.926 118.974 119.020 118.974 119.015
2015-05-02 2015 17 120.202 120.202 120.171 120.171 120.256 120.256 120.251 120.251
2015-05-09 2015 18 119.754 119.771 119.754 119.771 119.806 119.870 119.806 119.870
2015-05-16 2015 19 119.366 119.366 119.352 119.359 119.418 119.467 119.418 119.450
2015-05-23 2015 20 121.544 121.544 121.500 121.500 121.576 121.591 121.576 121.581
2015-05-30 2015 21 124.130 124.130 124.112 124.112 124.154 124.191 124.154 124.191
2015-06-06 2015 22 125.577 125.588 125.575 125.576 125.638 125.667 125.638 125.655
2015-06-13 2015 23 123.359 123.359 123.349 123.349 123.446 123.471 123.446 123.471
2015-06-20 2015 24 122.672 122.672 122.632 122.632 122.724 122.725 122.711 122.711
2015-06-27 2015 25 123.884 123.884 123.809 123.809 123.912 123.926 123.901 123.901
2015-07-04 2015 26 122.854 122.854 122.799 122.799 122.914 122.934 122.888 122.901
2015-07-11 2015 27 122.721 122.844 122.654 122.792 122.780 122.893 122.780 122.893
2015-07-18 2015 28 124.075 124.088 124.020 124.054 124.103 124.126 124.070 124.078
2015-07-25 2015 29 123.800 123.800 123.769 123.769 123.832 123.856 123.832 123.848
2015-08-01 2015 30 123.875 123.875 123.836 123.836 123.944 123.944 123.944 123.944
2015-08-08 2015 31 124.211 124.213 124.202 124.202 124.228 124.233 124.224 124.224
2015-08-15 2015 32 124.315 124.316 124.314 124.314 124.337 124.340 124.337 124.340
2015-08-22 2015 33 122.052 122.052 122.023 122.023 122.064 122.106 122.064 122.106
2015-08-29 2015 34 121.736 121.736 121.682 121.696 121.750 121.788 121.750 121.775
2015-09-05 2015 35 119.030 119.030 119.009 119.026 119.036 119.055 119.029 119.055
2015-09-12 2015 36 120.582 120.582 120.574 120.574 120.595 120.595 120.587 120.587
2015-09-19 2015 37 119.942 119.959 119.919 119.955 119.991 120.046 119.991 120.036
2015-09-26 2015 38 120.574 120.574 120.544 120.544 120.610 120.645 120.610 120.623
2015-10-03 2015 39 119.860 119.875 119.860 119.875 119.945 119.954 119.945 119.954
2015-10-10 2015 40 120.208 120.208 120.189 120.189 120.244 120.278 120.244 120.278
2015-10-17 2015 41 119.436 119.436 119.407 119.407 119.476 119.498 119.476 119.489
2015-10-24 2015 42 121.422 121.422 121.419 121.419 121.498 121.501 121.498 121.501
2015-10-31 2015 43 120.594 120.594 120.584 120.584 120.630 120.666 120.630 120.666
2015-11-07 2015 44 123.128 123.169 123.117 123.119 123.199 123.226 123.199 123.226
2015-11-14 2015 45 122.576 122.579 122.564 122.579 122.655 122.658 122.646 122.658
2015-11-21 2015 46 122.768 122.768 122.752 122.752 122.810 122.831 122.810 122.831
2015-11-28 2015 47 122.722 122.812 122.722 122.812 122.849 122.894 122.849 122.888
2015-12-05 2015 48 123.113 123.113 123.088 123.088 123.128 123.144 123.126 123.126
2015-12-12 2015 49 120.950 120.956 120.929 120.929 120.988 121.001 120.988 120.990
2015-12-19 2015 50 121.138 121.138 121.099 121.099 121.176 121.193 121.176 121.181
2015-12-26 2015 51 120.273 120.274 120.269 120.269 120.281 120.281 120.279 120.279
2016-01-02 2015 52 120.206 120.222 120.184 120.191 120.212 120.237 120.212 120.225
2016-01-09 2016 1 117.226 117.226 117.198 117.201 117.281 117.291 117.281 117.283
2016-01-16 2016 2 116.969 116.969 116.954 116.954 117.070 117.071 117.070 117.071
2016-01-23 2016 3 118.760 118.760 118.737 118.744 118.788 118.826 118.788 118.826
2016-01-30 2016 4 121.115 121.120 121.030 121.119 121.135 121.140 121.110 121.139
2016-02-06 2016 5 116.824 116.824 116.791 116.798 116.870 116.918 116.838 116.840
2016-02-13 2016 6 113.200 113.208 113.144 113.170 113.221 113.276 113.200 113.248
2016-02-20 2016 7 112.551 112.556 112.539 112.539 112.581 112.596 112.562 112.596
2016-02-27 2016 8 113.962 113.964 113.959 113.964 113.991 113.994 113.991 113.994
2016-03-05 2016 9 113.757 113.774 113.740 113.774 113.776 113.834 113.774 113.820
2016-03-12 2016 10 113.814 113.846 113.788 113.790 113.845 113.878 113.834 113.876
2016-03-19 2016 11 111.532 111.544 111.516 111.542 111.561 111.592 111.548 111.582
2016-03-26 2016 12 113.016 113.029 113.016 113.029 113.110 113.118 113.110 113.118
2016-04-02 2016 13 111.600 111.600 111.599 111.599 111.638 111.666 111.638 111.666
2016-04-09 2016 14 108.062 108.062 108.020 108.048 108.102 108.116 108.102 108.104
2016-04-16 2016 15 108.776 108.776 108.738 108.744 108.790 108.798 108.774 108.780
2016-04-23 2016 16 111.791 111.804 111.780 111.788 111.818 111.842 111.798 111.804
2016-04-30 2016 17 106.314 106.338 106.283 106.283 106.369 106.392 106.332 106.376
2016-05-07 2016 18 107.049 107.110 107.031 107.100 107.124 107.144 107.084 107.116
2016-05-14 2016 19 108.634 108.634 108.601 108.601 108.654 108.690 108.654 108.689
2016-05-21 2016 20 110.126 110.146 110.084 110.098 110.156 110.176 110.140 110.174
2016-05-28 2016 21 110.220 110.220 110.187 110.187 110.256 110.284 110.256 110.284
2016-06-04 2016 22 106.536 106.544 106.506 106.538 106.554 106.598 106.546 106.554
2016-06-11 2016 23 106.922 106.924 106.912 106.916 106.952 106.958 106.946 106.950
2016-06-18 2016 24 104.111 104.111 104.069 104.083 104.207 104.207 104.166 104.166
2016-06-25 2016 25 102.149 102.199 102.149 102.199 102.371 102.441 102.371 102.441
2016-07-02 2016 26 102.551 102.551 102.464 102.464 102.562 102.562 102.528 102.530
2016-07-09 2016 27 100.569 100.569 100.569 100.569 100.592 100.611 100.592 100.611
2016-07-16 2016 28 104.839 104.839 104.784 104.804 104.902 104.919 104.848 104.898
2016-07-23 2016 29 106.030 106.030 105.999 106.012 106.084 106.110 106.076 106.090
2016-07-30 2016 30 102.024 102.024 102.010 102.010 102.100 102.100 102.080 102.080
2016-08-06 2016 31 101.819 101.819 101.784 101.792 101.856 101.882 101.848 101.872
2016-08-13 2016 32 101.266 101.268 101.266 101.268 101.346 101.348 101.346 101.348
2016-08-20 2016 33 100.174 100.187 100.174 100.174 100.239 100.245 100.239 100.245
2016-08-27 2016 34 101.820 101.820 101.759 101.759 101.857 101.857 101.856 101.856
2016-09-03 2016 35 103.980 104.016 103.874 103.874 104.051 104.051 103.967 103.967
2016-09-10 2016 36 102.690 102.690 102.644 102.644 102.731 102.731 102.726 102.726
2016-09-17 2016 37 102.259 102.259 102.234 102.244 102.285 102.328 102.285 102.316
2016-09-24 2016 38 100.987 100.987 100.987 100.987 101.046 101.081 101.046 101.081
2016-10-01 2016 39 101.269 101.279 101.269 101.279 101.360 101.372 101.360 101.372
2016-10-08 2016 40 102.887 102.896 102.877 102.896 102.906 102.948 102.900 102.948
2016-10-15 2016 41 104.178 104.183 104.178 104.183 104.217 104.218 104.217 104.218
2016-10-22 2016 42 103.820 103.824 103.820 103.822 103.836 103.875 103.836 103.838
2016-10-29 2016 43 104.710 104.710 104.665 104.665 104.720 104.755 104.720 104.755
2016-11-05 2016 44 103.072 103.099 103.049 103.099 103.124 103.149 103.124 103.146
2016-11-12 2016 45 106.615 106.638 106.590 106.590 106.658 106.659 106.647 106.652
2016-11-19 2016 46 110.922 110.922 110.859 110.859 110.934 110.951 110.920 110.951
2016-11-26 2016 47 112.942 113.204 112.942 113.163 113.040 113.258 113.040 113.254
2016-12-03 2016 48 113.489 113.489 113.489 113.489 113.532 113.551 113.532 113.551
2016-12-10 2016 49 115.177 115.177 115.159 115.159 115.238 115.242 115.238 115.242
2016-12-17 2016 50 117.990 117.990 117.905 117.905 118.009 118.011 117.972 117.976
2016-12-24 2016 51 117.277 117.277 117.238 117.242 117.372 117.372 117.314 117.322
2017-01-01 2016 52 116.994 117.004 116.978 116.978 117.083 117.096 117.076 117.076
2017-01-08 2017 1 116.928 116.928 116.899 116.899 116.944 116.958 116.941 116.947
2017-01-14 2017 2 114.447 114.506 114.427 114.427 114.511 114.536 114.511 114.518
2017-01-21 2017 3 114.569 114.569 114.569 114.569 114.640 114.665 114.640 114.665
2017-01-28 2017 4 115.060 115.076 115.059 115.068 115.110 115.126 115.102 115.120
2017-02-04 2017 5 112.564 112.570 112.542 112.552 112.572 112.606 112.568 112.581
2017-02-11 2017 6 113.212 113.243 113.202 113.222 113.279 113.317 113.275 113.308
2017-02-18 2017 7 112.885 112.900 112.878 112.896 112.899 112.922 112.899 112.916
2017-02-25 2017 8 112.130 112.164 112.103 112.145 112.190 112.219 112.187 112.193
2017-03-04 2017 9 114.013 114.034 113.995 114.023 114.057 114.104 114.057 114.061
2017-03-11 2017 10 114.799 114.813 114.763 114.778 114.876 114.883 114.828 114.836
2017-03-18 2017 11 112.702 112.710 112.678 112.682 112.738 112.763 112.719 112.733
2017-03-25 2017 12 111.248 111.314 111.222 111.312 111.291 111.366 111.273 111.357
2017-04-01 2017 13 111.372 111.378 111.346 111.363 111.401 111.419 111.397 111.408
2017-04-08 2017 14 111.085 111.085 111.054 111.054 111.118 111.139 111.118 111.139
2017-04-15 2017 15 108.585 108.592 108.560 108.565 108.681 108.687 108.629 108.641
2017-04-22 2017 16 109.008 109.008 108.951 108.951 109.084 109.084 109.049 109.049
2017-04-29 2017 17 111.512 111.512 111.510 111.510 111.537 111.537 111.537 111.537
2017-05-06 2017 18 112.687 112.687 112.618 112.638 112.776 112.776 112.701 112.728
2017-05-13 2017 19 113.335 113.335 113.335 113.335 113.360 113.362 113.360 113.362
2017-05-20 2017 20 111.271 111.271 111.241 111.262 111.293 111.300 111.280 111.281
2017-05-27 2017 21 111.312 111.320 111.304 111.309 111.336 111.345 111.323 111.323
2017-06-03 2017 22 110.428 110.460 110.422 110.438 110.441 110.468 110.439 110.453
2017-06-10 2017 23 110.321 110.321 110.316 110.316 110.334 110.351 110.334 110.351
2017-06-17 2017 24 110.864 110.869 110.861 110.865 110.881 110.892 110.878 110.882
2017-06-24 2017 25 111.284 111.290 111.283 111.290 111.298 111.307 111.298 111.307
2017-07-01 2017 26 112.399 112.399 112.376 112.376 112.430 112.450 112.430 112.450
2017-07-08 2017 27 113.904 113.904 113.900 113.904 113.922 113.922 113.917 113.921
2017-07-15 2017 28 112.527 112.527 112.515 112.515 112.544 112.557 112.544 112.557
2017-07-22 2017 29 111.134 111.134 111.115 111.121 111.147 111.148 111.133 111.134
2017-07-29 2017 30 110.698 110.705 110.680 110.699 110.710 110.726 110.709 110.710
2017-08-05 2017 31 110.677 110.684 110.675 110.682 110.692 110.698 110.688 110.696
2017-08-12 2017 32 109.149 109.172 109.147 109.172 109.162 109.215 109.159 109.193
2017-08-19 2017 33 109.189 109.201 109.169 109.199 109.207 109.221 109.203 109.212
2017-08-26 2017 34 109.322 109.322 109.320 109.322 109.364 109.364 109.362 109.364
2017-09-02 2017 35 110.234 110.236 110.228 110.228 110.276 110.282 110.276 110.280
2017-09-09 2017 36 107.838 107.838 107.832 107.836 107.860 107.864 107.856 107.858
2017-09-16 2017 37 110.828 110.830 110.828 110.830 110.860 110.862 110.860 110.862
2017-09-23 2017 38 111.992 111.992 111.990 111.990 112.000 112.000 112.000 112.000
2017-09-30 2017 39 112.499 112.499 112.460 112.464 112.529 112.562 112.524 112.562
2017-10-07 2017 40 112.606 112.608 112.600 112.600 112.682 112.686 112.682 112.686
2017-10-14 2017 41 111.834 111.834 111.826 111.826 111.876 111.880 111.876 111.878
2017-10-21 2017 42 113.516 113.518 113.503 113.508 113.536 113.557 113.534 113.551
2017-10-28 2017 43 113.660 113.662 113.635 113.635 113.704 113.715 113.702 113.715
2017-11-04 2017 44 114.048 114.048 114.042 114.042 114.087 114.091 114.085 114.085
2017-11-11 2017 45 113.522 113.522 113.505 113.505 113.542 113.564 113.542 113.548
2017-11-18 2017 46 112.130 112.142 112.085 112.085 112.166 112.188 112.150 112.164
2017-11-25 2017 47 111.502 111.502 111.492 111.501 111.545 111.545 111.535 111.544
2017-12-02 2017 48 112.164 112.164 112.162 112.164 112.216 112.216 112.216 112.216
2017-12-09 2017 49 113.464 113.466 113.444 113.448 113.474 113.504 113.474 113.498
2017-12-16 2017 50 112.584 112.590 112.578 112.581 112.654 112.660 112.648 112.657
2017-12-23 2017 51 113.254 113.265 113.254 113.265 113.328 113.343 113.328 113.343
2017-12-31 2017 52 112.660 112.660 112.643 112.651 112.700 112.729 112.700 112.729
2018-01-07 2017 53 NA NA NA NA NA NA NA NA
2018-01-07 2018 1 113.032 113.032 113.018 113.018 113.092 113.100 113.090 113.098
2018-01-13 2018 2 111.002 111.006 110.988 110.996 111.044 111.060 111.026 111.052
2018-01-20 2018 3 110.814 110.814 110.814 110.814 110.856 110.856 110.854 110.854
2018-01-27 2018 4 108.624 108.626 108.589 108.589 108.634 108.648 108.632 108.632
2018-02-03 2018 5 110.153 110.153 110.152 110.152 110.195 110.195 110.195 110.195
2018-02-10 2018 6 108.780 108.780 108.768 108.770 108.812 108.824 108.812 108.824
2018-02-17 2018 7 106.300 106.300 106.272 106.272 106.312 106.325 106.303 106.315
2018-02-24 2018 8 106.863 106.863 106.858 106.858 106.919 106.919 106.914 106.914
2018-03-03 2018 9 105.722 105.722 105.696 105.712 105.730 105.762 105.730 105.757
2018-03-10 2018 10 106.807 106.818 106.807 106.814 106.850 106.850 106.822 106.822
2018-03-17 2018 11 105.964 105.966 105.953 105.953 106.001 106.007 106.001 106.007
2018-03-24 2018 12 104.728 104.730 104.708 104.712 104.744 104.766 104.742 104.766
2018-03-31 2018 13 106.261 106.261 106.258 106.260 106.312 106.312 106.312 106.312
2018-04-07 2018 14 106.926 106.926 106.913 106.915 106.950 106.962 106.950 106.962
2018-04-14 2018 15 107.334 107.338 107.334 107.338 107.377 107.385 107.377 107.385
2018-04-21 2018 16 107.628 107.628 107.616 107.616 107.656 107.674 107.656 107.674
2018-04-28 2018 17 109.042 109.046 109.022 109.022 109.074 109.088 109.064 109.080
2018-05-05 2018 18 109.055 109.059 109.055 109.056 109.098 109.105 109.098 109.105
2018-05-12 2018 19 109.360 109.360 109.358 109.358 109.412 109.412 109.410 109.410
2018-05-19 2018 20 110.746 110.746 110.730 110.736 110.760 110.789 110.760 110.783
2018-05-26 2018 21 109.378 109.380 109.362 109.362 109.398 109.409 109.398 109.409
2018-06-02 2018 22 109.514 109.514 109.488 109.488 109.524 109.548 109.524 109.535
2018-06-09 2018 23 109.511 109.536 109.507 109.509 109.554 109.558 109.550 109.554
2018-06-16 2018 24 110.644 110.650 110.644 110.644 110.687 110.692 110.687 110.691
2018-06-23 2018 25 109.982 109.984 109.976 109.976 109.992 109.994 109.984 109.984
2018-06-30 2018 26 110.678 110.678 110.666 110.666 110.698 110.708 110.698 110.708
2018-07-07 2018 27 110.450 110.454 110.446 110.449 110.477 110.499 110.477 110.499
## Tidy dataset for modelling.
data_m1 %<>% 
  mutate(open = (BidOpen + AskOpen)/2, close = (BidClose + AskClose)/2) %>% 
  dplyr::rename(high = BidHigh, low = AskLow) %>%  #use bid price for sell.
  dplyr::select(index, open, high, low, close)     # and ask price for buy.

Here I try to check if the filled dataset bias or not. Due to above I used open = (BidOpen + AskOpen)/2, high = BidHigh, low = AskLow and close = (BidClose + AskClose)/21. There will probably have bias.

tb3 <- data_m1 %>% mutate(
  bias.open = if_else(open>high|open<low, 1, 0), 
  bias.high = if_else(high<open|high<low|high<close, 1, 0), 
  bias.low = if_else(low>open|low>high|low>close, 1, 0), 
  bias.close = if_else(close>high|close<low, 1, 0)) %>% 
  dplyr::filter(bias.open==1|bias.high==1|bias.low==1|bias.close==1)# %>% 
#  kable(caption = 'Bias Imputation') %>% 
#  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
#  scroll_box(width = '100%', height = '400px')

tb3
## # A tibble: 709,076 x 9
##    index                open  high   low close bias.open bias.high bias.low
##    <dttm>              <dbl> <dbl> <dbl> <dbl>     <dbl>     <dbl>    <dbl>
##  1 2015-01-05 00:01:00  121.  121.  121.  121.         1         1        1
##  2 2015-01-05 00:02:00  121.  121.  121.  121.         1         1        1
##  3 2015-01-05 00:04:00  121.  121.  121.  121.         1         1        0
##  4 2015-01-05 00:05:00  121.  121.  121.  121.         1         1        0
##  5 2015-01-05 00:09:00  121.  121.  121.  121.         0         0        1
##  6 2015-01-05 00:10:00  121.  121.  121.  121.         1         1        1
##  7 2015-01-05 00:11:00  121.  121.  121.  121.         1         1        1
##  8 2015-01-05 00:12:00  121.  121.  121.  121.         1         1        1
##  9 2015-01-05 00:13:00  121.  121.  121.  121.         1         1        1
## 10 2015-01-05 00:14:00  121.  121.  121.  121.         0         0        1
## # ... with 709,066 more rows, and 1 more variable: bias.close <dbl>
# -------- eval=FALSE -----------
## Below prove that the dataset has no any bias or error.
> read_rds(paste0(dtr1, '/data_m1.rds')) %>% mutate(
+     open = BidOpen, high = BidHigh, low = BidLow, close = BidClose, 
+     bias.open = if_else(open>high|open<low, 1, 0), 
+     bias.high = if_else(high<open|high<low|high<close, 1, 0), 
+     bias.low = if_else(low>open|low>high|low>close, 1, 0), 
+     bias.close = if_else(close>high|close<low, 1, 0)) %>% 
+     dplyr::filter(bias.open==1|bias.high==1|bias.low==1|bias.close==1)
# A tibble: 0 x 19
# ... with 19 variables: index <dttm>, year <dbl>, week <dbl>, BidOpen <dbl>, BidHigh <dbl>, BidLow <dbl>,
#   BidClose <dbl>, AskOpen <dbl>, AskHigh <dbl>, AskLow <dbl>, AskClose <dbl>, open <dbl>, high <dbl>, low <dbl>,
#   close <dbl>, bias.open <dbl>, bias.high <dbl>, bias.low <dbl>, bias.close <dbl>

> read_rds(paste0(dtr, '/data_tm1.rds')) %>% mutate(
+     open = BidOpen, high = BidHigh, low = BidLow, close = BidClose, 
+     bias.open = if_else(open>high|open<low, 1, 0), 
+     bias.high = if_else(high<open|high<low|high<close, 1, 0), 
+     bias.low = if_else(low>open|low>high|low>close, 1, 0), 
+     bias.close = if_else(close>high|close<low, 1, 0)) %>% 
+     dplyr::filter(bias.open==1|bias.high==1|bias.low==1|bias.close==1)
# A tibble: 0 x 19
# ... with 19 variables: index <dttm>, year <dbl>, week <dbl>, AskOpen <dbl>, AskHigh <dbl>, AskLow <dbl>,
#   AskClose <dbl>, BidOpen <dbl>, BidHigh <dbl>, BidLow <dbl>, BidClose <dbl>, open <dbl>, high <dbl>, low <dbl>,
#   close <dbl>, bias.open <dbl>, bias.high <dbl>, bias.low <dbl>, bias.close <dbl>

> read_rds(paste0(dtr1, '/data_m1.rds')) %>% mutate(
+     open = AskOpen, high = AskHigh, low = AskLow, close = AskClose, 
+     bias.open = if_else(open>high|open<low, 1, 0), 
+     bias.high = if_else(high<open|high<low|high<close, 1, 0), 
+     bias.low = if_else(low>open|low>high|low>close, 1, 0), 
+     bias.close = if_else(close>high|close<low, 1, 0)) %>% 
+     dplyr::filter(bias.open==1|bias.high==1|bias.low==1|bias.close==1)
# A tibble: 0 x 19
# ... with 19 variables: index <dttm>, year <dbl>, week <dbl>, BidOpen <dbl>, BidHigh <dbl>, BidLow <dbl>,
#   BidClose <dbl>, AskOpen <dbl>, AskHigh <dbl>, AskLow <dbl>, AskClose <dbl>, open <dbl>, high <dbl>, low <dbl>,
#   close <dbl>, bias.open <dbl>, bias.high <dbl>, bias.low <dbl>, bias.close <dbl>

> read_rds(dtr1, paste0('/data_tm1.rds')) %>% mutate(
+     open = AskOpen, high = AskHigh, low = AskLow, close = AskClose, 
+     bias.open = if_else(open>high|open<low, 1, 0), 
+     bias.high = if_else(high<open|high<low|high<close, 1, 0), 
+     bias.low = if_else(low>open|low>high|low>close, 1, 0), 
+     bias.close = if_else(close>high|close<low, 1, 0)) %>% 
+     dplyr::filter(bias.open==1|bias.high==1|bias.low==1|bias.close==1)
# A tibble: 0 x 19
# ... with 19 variables: index <dttm>, year <dbl>, week <dbl>, AskOpen <dbl>, AskHigh <dbl>, AskLow <dbl>,
#   AskClose <dbl>, BidOpen <dbl>, BidHigh <dbl>, BidLow <dbl>, BidClose <dbl>, open <dbl>, high <dbl>, low <dbl>,
#   close <dbl>, bias.open <dbl>, bias.high <dbl>, bias.low <dbl>, bias.close <dbl>

I initially try to use bid for high and ask for low in order to produce a better prediction price for buy and sell. However, I use the mean value of OHLC all prices for this paper to avoid the statistical error/bias.

Due to 1min dataset is better than (more complete) tickdata-to-1min, here I use the 1min dataset.

if(!exists('data_m1')) {
  data_m1 <- read_rds(paste0(dtr1s, '/data_m1.rds'))
}
if(names(data_m1) %>% str_detect('Bid|Ask') %>% any()) {
data_m1 %<>% 
  mutate(open = (BidOpen + AskOpen)/2, 
         high = (BidHigh + AskHigh)/2, 
         low = (BidLow + AskLow)/2, 
         close = (BidClose + AskClose)/2) %>% 
  dplyr::select(index, open, high, low, close)
}
tb4 <- data_m1 %>% mutate(
  bias.open = if_else(open>high|open<low, 1, 0), 
  bias.high = if_else(high<open|high<low|high<close, 1, 0), 
  bias.low = if_else(low>open|low>high|low>close, 1, 0), 
  bias.close = if_else(close>high|close<low, 1, 0)) %>% 
  dplyr::filter(bias.open==1|bias.high==1|bias.low==1|bias.close==1)# %>% 
#  kable(caption = 'Bias Imputation') %>% 
#  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
#  scroll_box(width = '100%', height = '400px')

tb4
## # A tibble: 709,076 x 9
##    index                open  high   low close bias.open bias.high bias.low
##    <dttm>              <dbl> <dbl> <dbl> <dbl>     <dbl>     <dbl>    <dbl>
##  1 2015-01-05 00:01:00  121.  121.  121.  121.         1         1        1
##  2 2015-01-05 00:02:00  121.  121.  121.  121.         1         1        1
##  3 2015-01-05 00:04:00  121.  121.  121.  121.         1         1        0
##  4 2015-01-05 00:05:00  121.  121.  121.  121.         1         1        0
##  5 2015-01-05 00:09:00  121.  121.  121.  121.         0         0        1
##  6 2015-01-05 00:10:00  121.  121.  121.  121.         1         1        1
##  7 2015-01-05 00:11:00  121.  121.  121.  121.         1         1        1
##  8 2015-01-05 00:12:00  121.  121.  121.  121.         1         1        1
##  9 2015-01-05 00:13:00  121.  121.  121.  121.         1         1        1
## 10 2015-01-05 00:14:00  121.  121.  121.  121.         0         0        1
## # ... with 709,066 more rows, and 1 more variable: bias.close <dbl>
//<script type="text/javascript" src="//cdn.datacamp.com/dcl-react.js.gz"></script>

Source : DataCamp Light

You are feel free to surf Online Coding Platform Example for R, Python and also Shell.

4 Modelling

4.1 Seasonal Modelling

Below articles introduce TBATS models tbats() and Dynamic harmonic regression with multiple seasonal periods auto.arima(). Here I also includes ts(), MIDAS midasr(), GARCH-MIDAS, mcsGARCH and Levy Process for this research.

Progress Function

task_progress <- function(mbase, timeID0 = NULL, scs = 60, .pattern = '^mts|^sets', .loops = TRUE) {
  ## ------------- 定时查询进度 ----------------------
  ## 每分钟自动查询与更新以上模拟预测汇价进度(储存文件量)。
  require('magrittr')
  require('tibble')
  
  if(!is.data.frame(class(mbase))) { 
    mbase %<>% data.frame
  }
  
  if (.loops == TRUE) {
    while(1) {
      cat('Current Tokyo Time :', as.character(now('Asia/Tokyo')), '\n\n')
      
      y = as_date(mbase$index) %>% 
            unique
      y <- y[weekdays(y) != 'Saturday'] #filter and omit the weekly last price which is 12:00am on saturday
        datee = y
        
        if(is.null(timeID0)) { 
            timeID0 = y[1]
        } else if (is.Date(timeID0)) { 
            timeID0 = as_date(timeID0)
        } else {
            timeID0 = as_date(mbase$index) %>% 
            unique
        }
      
        y = y[y >= timeID0]
      
      x = list.files(paste0('./data/fx/USDJPY/'), pattern = .pattern) %>% 
          str_replace_all('.rds', '') %>% 
          str_replace_all('.201', '_201') %>% 
          str_split_fixed('_', '2') %>% 
          as_tibble %>% 
          dplyr::rename('Model' = 'V1', 'Date' = 'V2') %>% 
          mutate(Model = factor(Model), Date = as_date(Date))
        
      x = join(tibble(Date = datee), x) %>% 
          as_tibble   
      x %<>% na.omit
      
      x %<>% mutate(binary = if_else(is.na(Model), 0, 1)) %>% 
          spread(Model, binary)
      
      z <- ldply(x[,-1], function(zz) {
          na.omit(zz) %>% length }) %>% 
          dplyr::rename(x = V1) %>% 
          mutate(n = length(y), progress = percent(x/n))
      
      print(z)
      
      prg = sum(z$x)/sum(z$n)
      cat('\n================', as.character(percent(prg)), '================\n\n')
      
      if (prg == 1) break #倘若进度达到100%就停止更新。
      
      Sys.sleep(scs) #以上ldply()耗时3~5秒,而休息时间60秒。
    }
  } else {
    
    cat('Current Tokyo Time :', as.character(now('Asia/Tokyo')), '\n\n')
      
    
      y = as_date(mbase$index) %>% 
            unique
      datee = y
        
      if(is.null(timeID0)) { 
          timeID0 = y[1]
      } else if (is.Date(timeID0)) { 
          timeID0 = as_date(timeID0)
      } else {
          timeID0 = as_date(mbase$index) %>% 
          unique
      }
    
      y = y[y >= timeID0]
    
      x = list.files(paste0('./data/fx/USDJPY/'), pattern = .pattern) %>% 
          str_replace_all('.rds', '') %>% 
          str_replace_all('.201', '_201') %>% 
          str_split_fixed('_', '2') %>% 
          as_tibble %>% 
          dplyr::rename('Model' = 'V1', 'Date' = 'V2') %>% 
          mutate(Model = factor(Model), Date = as_date(Date))
        
      x = join(tibble(Date = datee), x) %>% 
          as_tibble
      x %<>% na.omit
      
      x %<>% mutate(binary = if_else(is.na(Model), 0, 1)) %>% 
          spread(Model, binary)
        
      z <- ldply(x[,-1], function(zz) {
          na.omit(zz) %>% length }) %>% 
          dplyr::rename(x = V1) %>% 
          mutate(n = length(y), progress = percent(x/n))
                
    print(z)
    
    prg = sum(z$x)/sum(z$n)
    cat('\n================', as.character(percent(prg)), '================\n\n')
    }
  }

4.2 Seasonal ETS

4.2.1 ETS ts()

The forecast.ets() will automatically use the optimal ets() which is similar theory with auto.arima().

4.2.2 Weekly >> Daily

I set the length of dataset as weekly but the frequency set as 1440 minutes (per day).

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#sets <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% weeks(1) + seconds(59), '/', dt + seconds(59))]
  
  sets <- smp %>% 
    tk_ts(frequency = 1440) %>% 
    forecast(h = 1440) %>% 
    llply(tk_tbl)
  
  if(is.double(sets$forecast$index[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    sets$forecast$index <- sq
    
  } else {
    sets$forecast$index <- data_m1$index[
    (which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1):(
     which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(sets, paste0('data/fx/USDJPY/sets.wk.1440.', 
                       as_date(sets$forecast$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/sets.wk.1440.', 
    as_date(sets$forecast$index[1]), '.rds saved!\n'))
  }

4.2.3 Monthly >> Daily

I set the length of dataset as monthly but the frequency set as 1440 minutes (per day). Initial forecast will be based on weekly dataset and then accumulated date-by-date until a monthly dataset.

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#sets <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% months(1) + seconds(59), '/', dt + seconds(59))]
  
  sets <- smp %>% 
    tk_ts(frequency = 1440) %>% 
    forecast(h=1440) %>% 
    llply(tk_tbl)
  
  if(is.double(sets$forecast$index[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    sets$forecast$index <- sq
    
  } else {
    sets$forecast$index <- data_m1$index[
    (which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1):(
     which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(sets, paste0('data/fx/USDJPY/sets.mo.1440.', 
                       as_date(sets$forecast$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/sets.mo.1440.', 
    as_date(sets$forecast$index[1]), '.rds saved!\n'))
  }

4.2.4 Quarterly >> Daily

I set the length of dataset as quarterly but the frequency set as 1440 minutes (per day). Initial forecast will be based on weekly dataset and then accumulated date-by-date until a quarterly dataset.

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#sets <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% months(3) + seconds(59), '/', dt + seconds(59))]
  
  sets <- smp %>% 
    tk_ts(frequency = 1440) %>% 
    forecast(h=1440) %>% 
    llply(tk_tbl)
  
  if(is.double(sets$forecast$index[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    sets$forecast$index <- sq
    
  } else {
    sets$forecast$index <- data_m1$index[
    (which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1):(
     which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(sets, paste0('data/fx/USDJPY/sets.qt.1440.', 
                       as_date(sets$forecast$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/sets.qt.1440.', 
    as_date(sets$forecast$index[1]), '.rds saved!\n'))
  }

4.2.5 Yearly >> Daily

I set the length of dataset as yearly but the frequency set as 1440 minutes (per day). Initial forecast will be based on weekly dataset and then accumulated date-by-date until a yearly dataset.

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#sets <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% years(1) + seconds(59), '/', dt + seconds(59))]
  
  sets <- smp %>% 
    tk_ts(frequency = 1440) %>% 
    forecast(h=1440) %>% 
    llply(tk_tbl)
  
  if(is.double(sets$forecast$index[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    sets$forecast$index <- sq
    
  } else {
    sets$forecast$index <- data_m1$index[
    (which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1):(
     which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(sets, paste0('data/fx/USDJPY/sets.yr.1440.', 
                       as_date(sets$forecast$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/sets.yr.1440.', 
    as_date(sets$forecast$index[1]), '.rds saved!\n'))
  }

4.2.6 Weekly >> Weekly

I set the length of dataset as weekly but the frequency set as 7200 minutes (per week).

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 7200)
#sets <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% weeks(1) + seconds(59), '/', dt + seconds(59))]
  
  sets <- smp %>% 
    tk_ts(frequency = 7200) %>% 
    forecast(h = 7200) %>% 
    llply(tk_tbl)
  
  if(is.double(sets$forecast$index[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    sets$forecast$index <- sq
    
  } else {
    sets$forecast$index <- data_m1$index[
    (which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1):(
     which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 7200)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(sets, paste0('data/fx/USDJPY/sets.wk.7200.', 
                       as_date(sets$forecast$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/sets.wk.7200.', 
    as_date(sets$forecast$index[1]), '.rds saved!\n'))
  }

4.2.7 Monthly >> Weekly

I set the length of dataset as monthly but the frequency set as 7200 minutes (per week).

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 7200)
#sets <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% months(1) + seconds(59), '/', dt + seconds(59))]
  
  sets <- smp %>% 
    tk_ts(frequency = 7200) %>% 
    forecast(h = 7200) %>% 
    llply(tk_tbl)
  
  if(is.double(sets$forecast$index[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    sets$forecast$index <- sq
    
  } else {
    sets$forecast$index <- data_m1$index[
    (which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1):(
     which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 7200)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(sets, paste0('data/fx/USDJPY/sets.mo.7200.', 
                       as_date(sets$forecast$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/sets.mo.7200.', 
    as_date(sets$forecast$index[1]), '.rds saved!\n'))
  }

4.2.8 Quarterly >> Weekly

I set the length of dataset as quarterly but the frequency set as 7200 minutes (per week).

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 7200)
#sets <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% months(3) + seconds(59), '/', dt + seconds(59))]
  
  sets <- smp %>% 
    tk_ts(frequency = 7200) %>% 
    forecast(h = 7200) %>% 
    llply(tk_tbl)
  
  if(is.double(sets$forecast$index[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    sets$forecast$index <- sq
    
  } else {
    sets$forecast$index <- data_m1$index[
    (which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1):(
     which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 7200)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(sets, paste0('data/fx/USDJPY/sets.qt.7200.', 
                       as_date(sets$forecast$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/sets.qt.7200.', 
    as_date(sets$forecast$index[1]), '.rds saved!\n'))
  }

4.2.9 Yearly >> Weekly

I set the length of dataset as yearly but the frequency set as 7200 minutes (per week).

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 7200)
#sets <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% years(1) + seconds(59), '/', dt + seconds(59))]
  
  sets <- smp %>% 
    tk_ts(frequency = 7200) %>% 
    forecast(h = 7200) %>% 
    llply(tk_tbl)
  
  if(is.double(sets$forecast$index[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    sets$forecast$index <- sq
    
  } else {
    sets$forecast$index <- data_m1$index[
    (which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1):(
     which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 7200)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(sets, paste0('data/fx/USDJPY/sets.yr.7200.', 
                       as_date(sets$forecast$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/sets.yr.7200.', 
    as_date(sets$forecast$index[1]), '.rds saved!\n'))
  }

4.3 Seasonal ARIMA

4.3.1 Introduce SARIMA

If you look at the help file of auto.arima and navigate to the section “Value”, you are directed to the help file of arima function and there you find the following (under the section “Value”) regarding the arma slot: A compact form of the specification, as a vector giving the number of AR, MA, seasonal AR and seasonal MA coefficients, plus the period and the number of non-seasonal and seasonal differences. That is what the seven elements you reported correspond to. In your case, you have a non-seasonal ARIMA(1,2,0).

Source : How to read p,d and q of auto.arima()? (which is 1 among the reference link above.)

So far, we have restricted our attention to non-seasonal data and non-seasonal ARIMA models. However, ARIMA models are also capable of modelling a wide range of seasonal data. A seasonal ARIMA model is formed by including additional seasonal terms in the ARIMA models we have seen so far. It is written as follows:

ARIMA \(\underbrace{(p, d, q)}\) \(\underbrace{(P, D, Q)_{m}}\)
Non-seasonal part of the model Seasonal part of the model

where m = number of observations per year. We use uppercase notation for the seasonal parts of the model, and lowercase notation for the non-seasonal parts of the model.

The seasonal part of the model consists of terms that are similar to the non-seasonal components of the model, but involve backshifts of the seasonal period. For example, an \(ARIMA(1,1,1)(1,1,1)_{4}\) model (without a constant) is for quarterly data (m = 4), and can be written as

\[(1 - {\color{Red}\phi_{1}}B)~(1 - {\color{Red}\Phi_{1}}B^{4}) (1 - B) (1 - B^{4})y_{t} = (1 + {\color{Red}\theta_{1}}B)~ (1 + {\color{Red}\Theta_{1}}B^{4})\varepsilon_{t}\]

The additional seasonal terms are simply multiplied by the non-seasonal terms.

auto.arima(euretail, stepwise=FALSE, approximation=FALSE) is better than auto.arima(euretail).

The auto.arima() function uses nsdiffs() to determine D (the number of seasonal differences to use), and ndiffs() to determine d (the number of ordinary differences to use). The selection of the other model parameters (p, q, P and Q) are all determined by minimizing the AICc, as with non-seasonal ARIMA models.

Source : 8.9 Seasonal ARIMA models (which is 1 among the reference link above.)

Above 8.5 Non-seasonal ARIMA models reference link describe the auto.arima() and the default setting is seasonal=TRUE where it will automatically model3 .

The default arguments are designed for rapid estimation of models for many time series. If you are analysing just one time series, and can afford to take some more time, it is recommended that you set stepwise=FALSE and approximation=FALSE. Non-stepwise selection can be slow, especially for seasonal data. The stepwise algorithm outlined in Hyndman & Khandakar (2008) is used except that the default method for selecting seasonal differences is now based on an estimate of seasonal strength (Wang, Smith & Hyndman, 2006) rather than the Canova-Hansen test. There are also some other minor variations to the algorithm described in Hyndman and Khandakar (2008).

Source : help section of auto.arima().

ARIMA(2,1,1)(1,0,0)[12] is seasonal ARIMA. [12] stands for number of periods in season, i.e. months in year in this case. (1,0,0) stands for seasonal part of model. Take a look at this.

Source : extract ARIMA specificaiton (which is 1 among the reference link above.)

You can force a seasonal model by setting D=1, although auto.arima() runs for quite some time with forced seasonality. (Note that the information criteria are not comparable between the original and the differenced series.) \[ \begin{array}{l,l,l} &\text{Training} & \text{Test}\\ \mathrm{ARIMA}(2,1,1) & 5.729 & 7.657\\ \mathrm{SARIMA}(1,1,0)_{52}\text{ with drift} & 6.481 & 7.390\\ \text{3 harmonics, }\mathrm{ARIMA}(2,1,0) & 5.578 & 5.151\\ \text{4 harmonics, }\mathrm{ARIMA}(2,1,1) & 5.219 & 5.188 \end{array} \]

Source : Seasonality not taken account of in auto.arima() (which is 1 among the reference link above.)

The problem with fitting seasonal ARIMA to daily data is that the “seasonal component” may only operate on the weekends or maybe just the weekdays thus overall there is a non-significnat “seasonal component”. Now what you have to do is to augment your data set with 6 dummies representing the days of the week and perhaps monthly indicators to represent annual effects. Now consider incorporating events such as holidays and include any lead, contemoraneous or lag effect around these known variables. No there may be unusual values (pulses) or level shifts or local time trends in the data. Furthermore the day-of-the-week effects may have changed over time e.g. there was no Saturday effect for the first 20 weeks but a Saturday effect for the last 50 weeks.If you wish to post tour daily data I will give it a try and maybe other readers of the list might also contribute their analysis to help guide you through this.

Source : Auto.arima with daily data: how to capture seasonality/periodicity?

4.3.2 Modelling SARIMA

4.3.2.1 Seasonal Data

Improved auto.arima() The auto.arima() function is widely used for automatically selecting ARIMA models. It works quite well, except that selection of \(D\), the order of seasonal differencing, has always been poor. Up until now, the default has been to use the Canova-Hansen test to select \(D\). Because the CH test has a null hypothesis of deterministic seasonality based on dummy variables, the function will often select \(D=0\). So I’ve now switched to using the OCSB test for selecting \(D\) which has a null hypothesis involving a seasonal difference, so it is much more likely to choose \(D=1\) than previously. I’ve done extensive testing of the forecasts obtained under the two methods, and the OCSB test leads to better forecasts. Hence it is now the default. This means that the function may return a different ARIMA model than previously when the data are seasonal. A separate function for selecting the seasonal order has also been made visible. So you can now call nsdiffs() to find the recommended number of seasonal differences without calling auto.arima(). There is also a ndiffs() function for selecting the number of first differences. Within auto.arima(), nsdiffs() is called first to select \(D\), and then ndiffs() is applied to diff(x,D) if \(D > 0\) or to \(x\) if \(D=0\).

Double-seasonal Holt-Winters The new dshw() function implements Taylor’s (2003) double-seasonal Holt-Winters method. This allows for two levels of seasonality. For example, with hourly data, there is often a daily period of 24 and a weekly period of 168. These are modelled separately in the dshw() function.

I am planning some major new functionality to extend this to the various types of complex seasonality discussed in my recent JASA paper. Hopefully that will be ready in the next few weeks – I have a research assistant working on the new code.

Source : Major changes to the forecast package

library(forecast)
# create some artifical data
modelfitsample <- data.frame(Customer_Visit=rpois(49,3000),Weekday=rep(1:7,7),
                             Christmas=c(rep(0,40),1,rep(0,8)),Day=1:49)

# Create matrix of numeric predictors
xreg <- cbind(Weekday=model.matrix(~as.factor(modelfitsample$Weekday)), 
                  Day=modelfitsample$Day,
              Christmas=modelfitsample$Christmas)

# Remove intercept
xreg <- xreg[,-1]

# Rename columns
colnames(xreg) <- c("Mon","Tue","Wed","Thu","Fri","Sat","Day","Christmas")

# Variable to be modelled
visits <- ts(modelfitsample$Customer_Visit, frequency=7)

# Find ARIMAX model
modArima <- auto.arima(visits, xreg=xreg)

Source : How to setup xreg argument in auto.arima() in R? [closed]

library(forecast)
ts_ <- ts(PaulsData$Temperature, frequency = 1)
msts_ <- msts(ts_, c(7,30,365))
fit <- auto.arima(ts_, seasonal=F, xreg=fourier(msts_, K=c(3,5,10)))  # i,j,k

Source : Find Arima equation using auto.arima, daily long-term data (msts), 3 seasonal regressors, and calculating K in fourier

ts_ <- data_m1$close %>% 
  ts()
mts_ <- data_m1 %>% 
  msts(seasonal.periods = c(1440, 7200), start = index(.)[1])
fit1 <- auto.arima(ts_, seasonal = FALSE, xreg=fourier(mts_, K=c(3,5,10)))
fit2 <- auto.arima(ts_, seasonal = FALSE, xreg=mts_)
fit3 <- auto.arima(ts_, D = 1, xreg=mts_)

## https://stackoverflow.com/questions/12161984/how-to-elegantly-convert-datetime-from-decimal-to-d-m-y-hms
## https://stackoverflow.com/questions/17738746/r-putting-time-series-with-frequency-of-20-min-into-the-function-stl
## https://stats.stackexchange.com/questions/120806/frequency-value-for-seconds-minutes-intervals-data-in-r
## http://manishbarnwal.com/blog/2017/05/03/time_series_and_forecasting_using_R/
smp %>% 
  tk_ts(start = index(index)[1], frequency = c(1440, 7200)) %>% 
  forecast %>% 
  llply(tk_tbl)

4.3.2.2 Weekly >> Daily ts()

Here I use ts() for seasonal data modeling and set auto.arima(D = 1, seasonal = TRUE) as sarima model, sarimax models will be modeled in next paper.

I set the length of dataset as nested seasonal dataset as weekly (1 week = 5 trading days = 7200 minutes) and daily (1 trading day = 1440 minutes).

# --------- eval=FALSE ---------
# sample, not run
> suppressWarnings(Y2015W1 %>% 
                     tk_xts %>% 
                     to.daily %>% 
                     Cl %>% 
                     opt_arma(arma=TRUE))
Using column `index` for date_var.
p d q P D Q s 
0 0 0 0 0 0 1
# --------- eval=FALSE ---------
# eval(parse(text = paste0(fs, "<- read_rds('", fls[[7]], "') %>% as_tibble")))
# sample, not run

sarima <- list()
for(i in (1:length(fs))) {
    smp <- data_m1 %>% tk_xts(silent = TRUE)
    timeID <- c(index(smp), xts::last(index(smp)) + minutes(1)) %>% 
      .[. > force_tz(ymd_hms('2015-01-05 00:00:00 EET'))]
    
    if (dt %in% timeID) {
      smp <- smp[paste0(dt, '/', dt %m+% weeks(1) - seconds(59))]
      
      sarima[[i]] <- tryCatch({llply(price_type, function(y) {
        df = auto.arima(smp, parallel=FALSE, num.cores = 2)
        df = data.frame(Date = index(df$latestPrice[1]), 
                        Type = paste0(names(df$latestPrice), '.', y), 
                        df$latestPrice, df$forecastPrice, t(df$AIC))
        names(df)[4] %<>% str_replace_all('1', 'T+1')
        df
      }) %>% as_tibble %>% bind_rows}, error = function(e) NULL)
      
      if (!dir.exists(paste0('data/fx/', names(sarima[[i]])[3]))) 
        dir.create(paste0('data/fx/', names(sarima[[i]])[3]))
      
      saveRDS(sarima[[i]], paste0(
        'data/fx/', names(sarima[[i]])[3], '/sarima.', 
        unique(sarima[[i]]$Date), '.rds'))
      
      cat(paste0(
        'data/fx/', names(sarima[[i]])[3], '/sarima.', 
        unique(sarima[[i]]$Date), '.rds saved!\n'))
      }
  }
# --------- eval=FALSE ---------
# sample, not run
smp <- data_m1 %>% tk_xts(silent = TRUE)
timeID <- c(index(smp), xts::last(index(smp)) + minutes(1)) %>% 
  .[. > force_tz(ymd_hms('2015-01-05 00:00:00 EET'))]
dt <- timeID[1]
smp <- smp[paste0(dt, '/', dt %m+% weeks(1) - seconds(59))]

smp %>% tk_ts %>% forecast %>% llply(tk_tbl)

mts <- multi_seasons(smp)
aar <- multi_seasons(smp, auto_arima=TRUE)

Below Arima() and auto.arima() functions prove that auto.arima() is better model since it auto adjust the best arima(p,d,q) values.

# --------- eval=FALSE ---------
# sample, not run
> n <- 2000
> m <- 200
> y <- ts(rnorm(n) + (1:n)%%100/30, f=m)

> library(forecast)
> fit <- Arima(y, order=c(2,0,1), xreg=fourier(y, K=4))
> fit
Series: y 
Regression with ARIMA(2,0,1) errors 

Coefficients:
         ar1     ar2      ma1  intercept  S1-200  C1-200   S2-200   C2-200  S3-200   C3-200   S4-200
      0.3846  0.0649  -0.2794     1.6168  0.0354  0.0308  -1.0026  -0.0222  0.0677  -0.0163  -0.5295
s.e.  0.1588  0.0324   0.1584     0.0320  0.0453  0.0452   0.0452   0.0451  0.0450   0.0450   0.0448
      C4-200
      0.0059
s.e.  0.0447

sigma^2 estimated as 1.204:  log likelihood=-3017.65
AIC=6061.3   AICc=6061.49   BIC=6134.11

> fit2 <- auto.arima(y, seasonal=FALSE, xreg=fourier(y, K=4))
> fit2
Series: y 
Regression with ARIMA(1,0,2) errors 

Coefficients:
         ar1      ma1     ma2  intercept  S1-200  C1-200   S2-200   C2-200  S3-200   C3-200   S4-200
      0.4605  -0.3566  0.0605     1.6168  0.0354  0.0309  -1.0026  -0.0222  0.0677  -0.0164  -0.5296
s.e.  0.1319   0.1322  0.0297     0.0319  0.0451  0.0451   0.0450   0.0450  0.0449   0.0449   0.0447
      C4-200
      0.0057
s.e.  0.0447

sigma^2 estimated as 1.204:  log likelihood=-3017.44
AIC=6060.87   AICc=6061.06   BIC=6133.69

> fit$aic
[1] 6061.302
> fit2$aic
[1] 6060.873

Modeling

# --------- eval=FALSE ---------
# measure as sample take from next chunk
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]
dt <- timeID[1]

smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
dt %<>% as_date
smp <- smp[paste0(dt %m-% weeks(1) + seconds(59), '/', dt + seconds(59))]

sarimats <- smp %>% 
    tk_ts(frequency = 1440)

## 
fit_ts <- auto.arima(Op(sarimats), D = 1)#, trace = TRUE)
saveRDS(fit_ts, 'data/fx/USDJPY/sarima_ts_sample.rds')

## 
fr_ts <- forecast(fit_ts, h = 1440)
saveRDS(fr_ts, 'data/fx/USDJPY/sarima_frts_sample.rds')

## 
sq <- smp %>% 
  tail(1) %>% 
  index
if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
fr_ts.sample <- as_tibble(data.frame(index = sq, fr_ts)) %>% 
  dplyr::select(index, Point.Forecast)
dt.sample <- dplyr::filter(data_m1, index %in% fr_ts.sample$index) %>% 
  dplyr::select(index, open)
fr_ts.sample <- join(dt.sample, fr_ts.sample) %>% 
  as_tibble %>% 
  dplyr::rename(sarima_ts = Point.Forecast)

if(!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))

saveRDS(fr_ts.sample, paste0('data/fx/USDJPY/fr_ts.sample.wk.1440.', 
                         as_date(fr_ts.sample$index[1]), '.rds'))

cat(paste0(
    'data/fx/USDJPY/fr_ts.sample.wk.1440.', 
    as_date(fr_ts.sample$index[1]), '.rds saved!\n'))

Due to above model consume few hours, here I can only use a sample to compare the accuracy.

# --------- eval=FALSE ---------
#Not run
#sq <- seq(1 , length(data_m1$index), by = 1440)
#sets <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% weeks(1) + seconds(59), '/', dt + seconds(59))]
  
  sarimats <- smp %>% 
    tk_ts(frequency = 1440)
    #https://stackoverflow.com/a/37046276/3806250 #auto.arima(x, D = 1)
    #https://stackoverflow.com/a/37400899/3806250 #auto.arima(x, seasonal = TRUE)
  
  sarimats <- llply(., function(x) {
    auto.arima(x, D = 1) %>% #, trace = TRUE) %>% 
      forecast(h = 1440)
    }) %>% 
    llply(tk_tbl)
  
  ## ----------------------------------------
  ## Not yet test run
  sq <- smp %>% 
    tail(1) %>% 
    index
  if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
  sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
  dtf <- as_tibble(data.frame(index = sq, sarimats)) %>% 
    dplyr::select(index, Point.Forecast)
  dts <- dplyr::filter(data_m1, index %in% dtf$index) %>% 
    dplyr::select(index, open)
  dtf <- join(dt.sample, dtf) %>% 
    as_tibble
  
  if(!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))

  saveRDS(dtf, paste0('data/fx/USDJPY/sarima_ts.wk.1440.', 
                        as_date(dtf$index[1]), '.rds'))

  cat(paste0('data/fx/USDJPY/sarima_ts.wk.1440.', 
             as_date(dtf$index[1]), '.rds saved!\n'))
  ## ----------------------------------------
  }

4.3.2.3 Monthly >> Weekly >> Daily ts()

I set the length of dataset as 3 level nested seasonal dataset as monthly (), weekly (1 week = 5 trading days = 7200 minutes) and daily (1 trading day = 1440 minutes).

4.3.2.4 Yearly >> Weekly >> Daily ts()

I set the length of dataset as 3 level nested seasonal dataset as monthly (1 year = ), weekly (1 week = 5 trading days = 7200 minutes) and daily (1 trading day = 1440 minutes).

4.3.2.5 Weekly >> Daily msts()

Modeling

# --------- eval=FALSE ---------
# measure as sample take from next chunk
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]
dt <- timeID[1]

smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
dt %<>% as_date
smp <- smp[paste0(dt %m-% weeks(1) + seconds(59), '/', dt + seconds(59))]

## Dataset has 7200 observations which is 7200 mins per week
## due to not enough data to run, here I set as 60 mins and 1440 mins, therefore it can loop 5 days.
#mts <- smp %>% 
#    msts(seasonal.periods = c(1440, 7200))
sarimamsts <- smp %>% 
  msts(seasonal.periods = c(60, 1440))

##
fit_msts <- auto.arima(Op(sarimamsts), D = 1)#, trace = TRUE)
saveRDS(fit_msts, 'data/fx/USDJPY/sarima_msts_sample.rds')

##
fr_msts <- forecast(fit_msts, h = 1440)
saveRDS(fr_msts, 'data/fx/USDJPY/sarima_frmsts_sample.rds')

##

## 
sq <- smp %>% 
  tail(1) %>% 
  index
if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')

fr_msts.sample <- data.frame(index = sq, fr_msts) %>% 
  dplyr::select(index, Point.Forecast) %>% as_tibble
rownames(fr_msts.sample) <- NULL
dt.sample <- dplyr::filter(data_m1, index %in% fr_msts.sample$index) %>% 
  dplyr::select(index, open)
fr_msts.sample <- join(dt.sample, fr_msts.sample) %>% 
  as_tibble %>% 
  dplyr::rename(sarima_msts = Point.Forecast)

if(!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))

saveRDS(fr_msts.sample, paste0('data/fx/USDJPY/fr_msts.sample.wk.1440.', 
                         as_date(fr_msts.sample$index[1]), '.rds'))

cat(paste0(
    'data/fx/USDJPY/fr_msts.sample.wk.1440.', 
    as_date(fr_msts.sample$index[1]), '.rds saved!\n'))
# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#mts <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% weeks(1) + seconds(59), '/', dt + seconds(59))]
  
  sarimamsts <- smp %>% 
    msts(seasonal.periods = c(1440, 7200))
  
  sarimamsts <- llply(1:ncol(sarimamsts), function(i) {
    y <- sarimamsts[,i] %>% 
      auto.arima(D = 1) %>% 
      forecast(h = 1440) %>% 
      as_tibble
      #names(y)[1] <- names(smp)[i]
      #names(y)[2:ncol(y)] <- paste0(names(y)[1], '.', names(y)[2:ncol(y)])
      #names(y)[1] <- paste0(names(smp)[i], '.Point.Forecast')
      names(y)[1] <- names(smp)[i]
      y
    }) %>% 
    bind_rows %>% 
    mutate(Model = factor('tbats'), Period = factor('dy.wk'), type = case_when(
      !is.na(open) ~ 'open', 
      !is.na(high) ~ 'high', 
      !is.na(low) ~ 'low', 
      !is.na(close) ~ 'close')) %>% 
    dlply(.(type, Period), function(x) {
      x %<>% dplyr::rename(open.Point.Forecast = open, 
                           high.Point.Forecast = high, 
                           low.Point.Forecast = low, 
                           close.Point.Forecast = close)
      names(x)[str_detect(names(x), '80|95')] <- paste0(x$type[1], '.', names(x)[str_detect(names(x), '80|95')])
      x[colSums(!is.na(x)) > 0] %>% 
        data.frame %>% 
        as_tibble %>% 
        dplyr::select(-type)
      
      }) %>% 
    bind_cols %>% 
    as_tibble 
  sarimamsts <- sarimamsts[c('open.Point.Forecast', 'high.Point.Forecast', 'low.Point.Forecast', 'close.Point.Forecast', 
               'open.Lo.80', 'open.Hi.80', 'open.Lo.95', 'open.Hi.95', 
               'high.Lo.80', 'high.Hi.80', 'high.Lo.95', 'high.Hi.95', 
               'low.Lo.80', 'low.Hi.80', 'low.Lo.95', 'low.Hi.95', 
               'close.Lo.80', 'close.Hi.80', 'close.Lo.95', 'close.Hi.95')]
  #sarimamsts[str_detect(names(sarimamsts), 'Model.|Period.')] <- NULL
  
  ## ----------------------------------------
  ## Not yet test run  if(is.numeric(index(sarimamsts)[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    n <- nrow(sarimamsts) / length(sq)
    
    sarimamsts <- cbind(index = rep(sq, n), sarimamsts) %>% 
      as_tibble
    
  } else {
    stop('index of dataset does not assign.')
    #sarimamsts$forecast$index <- data_m1$index[
    #(which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1):(
    # which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(sarimamsts, paste0('data/fx/USDJPY/sarimamsts.sample.dy.wk.', 
                       as_date(sarimamsts$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/sarimamsts.sample.dy.wk.', 
    as_date(sarimamsts$index[1]), '.rds saved!\n'))
  ## ----------------------------------------
  }

Due to above model consume few hours, here I can only use a sample to compare the accuracy.

4.4 TBATS forecast::tbats()

4.4.1 Modelling

4.4.2 Nested Daily-Weekly Model

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#mts <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% weeks(1) + seconds(59), '/', dt + seconds(59))]
  
  mts <- smp %>% 
    msts(seasonal.periods = c(1440, 7200))
  
  mts <- llply(1:ncol(mts), function(i) {
    y <- mts[,i] %>% 
      tbats %>% 
      forecast(h = 1440) %>% 
      as_tibble
      #names(y)[1] <- names(smp)[i]
      #names(y)[2:ncol(y)] <- paste0(names(y)[1], '.', names(y)[2:ncol(y)])
      #names(y)[1] <- paste0(names(smp)[i], '.Point.Forecast')
      names(y)[1] <- names(smp)[i]
      y
    }) %>% 
    bind_rows %>% 
    mutate(Model = factor('tbats'), Period = factor('dy.wk'), type = case_when(
      !is.na(open) ~ 'open', 
      !is.na(high) ~ 'high', 
      !is.na(low) ~ 'low', 
      !is.na(close) ~ 'close')) %>% 
    dlply(.(type, Period), function(x) {
      x %<>% dplyr::rename(open.Point.Forecast = open, 
                           high.Point.Forecast = high, 
                           low.Point.Forecast = low, 
                           close.Point.Forecast = close)
      names(x)[str_detect(names(x), '80|95')] <- paste0(x$type[1], '.', names(x)[str_detect(names(x), '80|95')])
      x[colSums(!is.na(x)) > 0] %>% 
        data.frame %>% 
        as_tibble %>% 
        dplyr::select(-type)
      
      }) %>% 
    bind_cols %>% 
    as_tibble 
  mts <- mts[c('open.Point.Forecast', 'high.Point.Forecast', 'low.Point.Forecast', 'close.Point.Forecast', 
               'open.Lo.80', 'open.Hi.80', 'open.Lo.95', 'open.Hi.95', 
               'high.Lo.80', 'high.Hi.80', 'high.Lo.95', 'high.Hi.95', 
               'low.Lo.80', 'low.Hi.80', 'low.Lo.95', 'low.Hi.95', 
               'close.Lo.80', 'close.Hi.80', 'close.Lo.95', 'close.Hi.95')]
  #mts[str_detect(names(mts), 'Model.|Period.')] <- NULL
  
  if(is.numeric(index(mts)[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    n <- nrow(mts) / length(sq)
    
    mts <- cbind(index = rep(sq, n), mts) %>% 
      as_tibble
    
  } else {
    stop('index of dataset does not assign.')
    #mts$forecast$index <- data_m1$index[
    #(which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1):(
    # which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(mts, paste0('data/fx/USDJPY/mts.dy.wk.', 
                       as_date(mts$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/mts.dy.wk.', 
    as_date(mts$index[1]), '.rds saved!\n'))
  }

4.4.3 Nested Daily-Weekly-Monthly Model

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#mts <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% months(1) + seconds(59), '/', dt + seconds(59))]
  
  mts <- smp %>% 
    msts(seasonal.periods = c(1440, 7200, nrow(smp)))
  
  mts <- llply(1:ncol(mts), function(i) {
    y <- mts[,i] %>% 
      tbats %>% 
      forecast(h = 1440) %>% 
      as_tibble
      names(y)[1] <- names(smp)[i]
      y
    }) %>% 
    bind_rows %>% 
    mutate(Model = factor('tbats'), Period = factor('dy.wk.mo'), type = case_when(
      !is.na(open) ~ 'open', 
      !is.na(high) ~ 'high', 
      !is.na(low) ~ 'low', 
      !is.na(close) ~ 'close')) %>% 
    dlply(.(type, Period), function(x) {
      x %<>% dplyr::rename(open.Point.Forecast = open, 
                           high.Point.Forecast = high, 
                           low.Point.Forecast = low, 
                           close.Point.Forecast = close)
      names(x)[str_detect(names(x), '80|95')] <- paste0(x$type[1], '.', names(x)[str_detect(names(x), '80|95')])
      x[colSums(!is.na(x)) > 0] %>% 
        data.frame %>% 
        as_tibble %>% 
        dplyr::select(-type)
      
      }) %>% 
    join_all %>% 
    as_tibble
  
  if(is.numeric(index(mts)[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    n <- nrow(mts) / length(sq)
    
    mts <- cbind(index = rep(sq, n), mts) %>% 
      as_tibble
    
  } else {
    stop('index of dataset does not assign.')
    #mts$forecast$index <- data_m1$index[
    #(which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1):(
    # which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(mts, paste0('data/fx/USDJPY/mts.dy.wk.mo.', 
                       as_date(mts$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/mts.dy.wk.mo.', 
    as_date(mts$index[1]), '.rds saved!\n'))
  }

4.4.4 Nested Daily-Weekly-Quarterly Model

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#mts <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% months(3) + seconds(59), '/', dt + seconds(59))]
  
  mts <- smp %>% 
    msts(seasonal.periods = c(1440, 7200, nrow(smp)))
  
  mts <- llply(1:ncol(mts), function(i) {
    y <- mts[,i] %>% 
      tbats %>% 
      forecast(h = 1440) %>% 
      as_tibble
      names(y)[1] <- names(smp)[i]
      y
    }) %>% 
    bind_rows %>% 
    mutate(Model = factor('tbats'), Period = factor('dy.wk.qt'), type = case_when(
      !is.na(open) ~ 'open', 
      !is.na(high) ~ 'high', 
      !is.na(low) ~ 'low', 
      !is.na(close) ~ 'close')) %>% 
    dlply(.(type, Period), function(x) {
      x %<>% dplyr::rename(open.Point.Forecast = open, 
                           high.Point.Forecast = high, 
                           low.Point.Forecast = low, 
                           close.Point.Forecast = close)
      names(x)[str_detect(names(x), '80|95')] <- paste0(x$type[1], '.', names(x)[str_detect(names(x), '80|95')])
      x[colSums(!is.na(x)) > 0] %>% 
        data.frame %>% 
        as_tibble %>% 
        dplyr::select(-type)
      
      }) %>% 
    join_all %>% 
    as_tibble
  
  if(is.numeric(index(mts)[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    n <- nrow(mts) / length(sq)
    
    mts <- cbind(index = rep(sq, n), mts) %>% 
      as_tibble
    
  } else {
    stop('index of dataset does not assign.')
    #mts$forecast$index <- data_m1$index[
    #(which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1):(
    # which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(mts, paste0('data/fx/USDJPY/mts.dy.wk.qt.', 
                       as_date(mts$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/mts.dy.wk.qt.', 
    as_date(mts$index[1]), '.rds saved!\n'))
  }

Due to heavily calculation and based on the comparison section proved that 2 levels (or layers) nested model more effective than 3 levels (or layers) models, here I skip above model.

4.4.5 Nested Daily-Weekly-Yearly Model

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#mts <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% years(1) + seconds(59), '/', dt + seconds(59))]
  
  mts <- smp %>% 
    msts(seasonal.periods = c(1440, 7200, nrow(smp)))
  
  mts <- llply(1:ncol(mts), function(i) {
    y <- mts[,i] %>% 
      tbats %>% 
      forecast(h = 1440) %>% 
      as_tibble
      names(y)[1] <- names(smp)[i]
      y
    }) %>% 
    bind_rows %>% 
    mutate(Model = factor('tbats'), Period = factor('dy.wk.yr'), type = case_when(
      !is.na(open) ~ 'open', 
      !is.na(high) ~ 'high', 
      !is.na(low) ~ 'low', 
      !is.na(close) ~ 'close')) %>% 
    dlply(.(type, Period), function(x) {
      x %<>% dplyr::rename(open.Point.Forecast = open, 
                           high.Point.Forecast = high, 
                           low.Point.Forecast = low, 
                           close.Point.Forecast = close)
      names(x)[str_detect(names(x), '80|95')] <- paste0(x$type[1], '.', names(x)[str_detect(names(x), '80|95')])
      x[colSums(!is.na(x)) > 0] %>% 
        data.frame %>% 
        as_tibble %>% 
        dplyr::select(-type)
      
      }) %>% 
    join_all %>% 
    as_tibble
  
  if(is.numeric(index(mts)[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    n <- nrow(mts) / length(sq)
    
    mts <- cbind(index = rep(sq, n), mts) %>% 
      as_tibble
    
  } else {
    stop('index of dataset does not assign.')
    #mts$forecast$index <- data_m1$index[
    #(which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1):(
    # which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(mts, paste0('data/fx/USDJPY/mts.dy.wk.yr.', 
                       as_date(mts$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/mts.dy.wk.yr.', 
    as_date(mts$index[1]), '.rds saved!\n'))
  }

Due to heavily calculation and based on the comparison section proved that 2 levels (or layers) nested model more effective than 3 levels (or layers) models, here I skip above model.

4.4.6 Nested Daily-Weekly-Monthly-Quarterly-Yearly Model

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#mts <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  
  ##https://robjhyndman.com/hyndsight/seasonal-periods/
  yr1 <- smp[paste0(dt %m-% years(1) + seconds(59), '/', dt + seconds(59))]
  qt1 <- smp[paste0(dt %m-% months(3) + seconds(59), '/', dt + seconds(59))]
  
  mts <- smp %>% 
    msts(seasonal.periods = c(1440, 7200, nrow(qt1), nrow(yr1)))
  
  mts <- llply(1:ncol(mts), function(i) {
    y <- mts[,i] %>% 
      tbats %>% 
      forecast(h = 1440) %>% 
      as_tibble
      names(y)[1] <- names(smp)[i]
      y
    }) %>% 
    bind_rows %>% 
    mutate(Model = factor('tbats'), Period = factor('dy.wk.qt.yr'), type = case_when(
      !is.na(open) ~ 'open', 
      !is.na(high) ~ 'high', 
      !is.na(low) ~ 'low', 
      !is.na(close) ~ 'close')) %>% 
    dlply(.(type, Period), function(x) {
      x %<>% dplyr::rename(open.Point.Forecast = open, 
                           high.Point.Forecast = high, 
                           low.Point.Forecast = low, 
                           close.Point.Forecast = close)
      names(x)[str_detect(names(x), '80|95')] <- paste0(x$type[1], '.', names(x)[str_detect(names(x), '80|95')])
      x[colSums(!is.na(x)) > 0] %>% 
        data.frame %>% 
        as_tibble %>% 
        dplyr::select(-type)
      
      }) %>% 
    join_all %>% 
    as_tibble
  
  if(is.numeric(index(mts)[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    n <- nrow(mts) / length(sq)
    
    mts <- cbind(index = rep(sq, n), mts) %>% 
      as_tibble
    
  } else {
    stop('index of dataset does not assign.')
    #mts$forecast$index <- data_m1$index[
    #(which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1):(
    # which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(mts, paste0('data/fx/USDJPY/mts.dy.wk.qt.yr.', 
                       as_date(mts$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/mts.dy.wk.qt.yr.', 
    as_date(mts$index[1]), '.rds saved!\n'))
  }

Due to heavily calculation and based on the comparison section proved that 2 levels (or layers) nested model more effective than 3 levels (or layers) models, here I skip above model.

4.4.7 Nested Daily-Quarterly Model

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#mts <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% months(3) + seconds(59), '/', dt + seconds(59))]
  
  mts <- smp %>% 
    msts(seasonal.periods = c(1440, nrow(smp)))
  
  mts <- llply(1:ncol(mts), function(i) {
    y <- mts[,i] %>% 
      tbats %>% 
      forecast(h = 1440) %>% 
      as_tibble
      names(y)[1] <- names(smp)[i]
      y
    }) %>% 
    bind_rows %>% 
    mutate(Model = factor('tbats'), Period = factor('dy.qt'), type = case_when(
      !is.na(open) ~ 'open', 
      !is.na(high) ~ 'high', 
      !is.na(low) ~ 'low', 
      !is.na(close) ~ 'close')) %>% 
    dlply(.(type, Period), function(x) {
      x %<>% dplyr::rename(open.Point.Forecast = open, 
                           high.Point.Forecast = high, 
                           low.Point.Forecast = low, 
                           close.Point.Forecast = close)
      names(x)[str_detect(names(x), '80|95')] <- paste0(x$type[1], '.', names(x)[str_detect(names(x), '80|95')])
      x[colSums(!is.na(x)) > 0] %>% 
        data.frame %>% 
        as_tibble %>% 
        dplyr::select(-type)
      
      }) %>% 
    bind_cols %>% 
    as_tibble 
  mts <- mts[c('open.Point.Forecast', 'high.Point.Forecast', 'low.Point.Forecast', 'close.Point.Forecast', 
               'open.Lo.80', 'open.Hi.80', 'open.Lo.95', 'open.Hi.95', 
               'high.Lo.80', 'high.Hi.80', 'high.Lo.95', 'high.Hi.95', 
               'low.Lo.80', 'low.Hi.80', 'low.Lo.95', 'low.Hi.95', 
               'close.Lo.80', 'close.Hi.80', 'close.Lo.95', 'close.Hi.95')]
  #mts[str_detect(names(mts), 'Model.|Period.')] <- NULL
  
  if(is.numeric(index(mts)[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    n <- nrow(mts) / length(sq)
    
    mts <- cbind(index = rep(sq, n), mts) %>% 
      as_tibble
    
  } else {
    stop('index of dataset does not assign.')
    #mts$forecast$index <- data_m1$index[
    #(which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1):(
    # which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(mts, paste0('data/fx/USDJPY/mts.dy.qt.', 
                       as_date(mts$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/mts.dy.qt.', 
    as_date(mts$index[1]), '.rds saved!\n'))
  }

4.4.8 Nested Daily-Yearly Model

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#mts <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% years(1) + seconds(59), '/', dt + seconds(59))]
  
  mts <- smp %>% 
    msts(seasonal.periods = c(1440, nrow(smp)))
  
  mts <- llply(1:ncol(mts), function(i) {
    y <- mts[,i] %>% 
      tbats %>% 
      forecast(h = 1440) %>% 
      as_tibble
      names(y)[1] <- names(smp)[i]
      y
    }) %>% 
    bind_rows %>% 
    mutate(Model = factor('tbats'), Period = factor('dy.yr'), type = case_when(
      !is.na(open) ~ 'open', 
      !is.na(high) ~ 'high', 
      !is.na(low) ~ 'low', 
      !is.na(close) ~ 'close')) %>% 
    dlply(.(type, Period), function(x) {
      x %<>% dplyr::rename(open.Point.Forecast = open, 
                           high.Point.Forecast = high, 
                           low.Point.Forecast = low, 
                           close.Point.Forecast = close)
      names(x)[str_detect(names(x), '80|95')] <- paste0(x$type[1], '.', names(x)[str_detect(names(x), '80|95')])
      x[colSums(!is.na(x)) > 0] %<>% 
        data.frame %>% 
        as_tibble %>% 
        dplyr::select(-type)
      #x[c(ncol(x), ncol(x)-1, x[1:(ncol(x)-2)])] #Due to xts format attr, there will be not in order.
      
      }) %>% 
    bind_cols %>% 
    as_tibble 
  mts <- mts[c('open.Point.Forecast', 'high.Point.Forecast', 'low.Point.Forecast', 'close.Point.Forecast', 
               'open.Lo.80', 'open.Hi.80', 'open.Lo.95', 'open.Hi.95', 
               'high.Lo.80', 'high.Hi.80', 'high.Lo.95', 'high.Hi.95', 
               'low.Lo.80', 'low.Hi.80', 'low.Lo.95', 'low.Hi.95', 
               'close.Lo.80', 'close.Hi.80', 'close.Lo.95', 'close.Hi.95')]
  #mts[str_detect(names(mts), 'Model.|Period.')] <- NULL
  
  if(is.numeric(index(mts)[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    n <- nrow(mts) / length(sq)
    
    mts <- cbind(index = rep(sq, n), mts) %>% 
      as_tibble
    
  } else {
    stop('index of dataset does not assign.')
    #mts$forecast$index <- data_m1$index[
    #(which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1):(
    # which(data_m1$index == smp %>% 
    #         index %>% 
    #         xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(mts, paste0('data/fx/USDJPY/mts.dy.yr.', 
                       as_date(mts$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/mts.dy.yr.', 
    as_date(mts$index[1]), '.rds saved!\n'))
  }
seasonal_m1 <- read_rds('data/fx/USDJPY/seasonal_m1.rds')
yr_2018 <- data.table(seasonal_m1)[as_date(index) > as_date('2017-12-31')]

dy.qt_dy.yr_2018 <- yr_2018[Model == 'tbats' & Period %in% c('dy.qt', 'dy.yr')]

4.4.9 Nested Weekly-Weekly Model

Based on the comparison section proved that daily (1440 mins) nested model more effective than weekly (7200 mins) nested models, here I skip above model.

4.4.10 Nested Weekly-Monthly Model

Based on the comparison section proved that daily (1440 mins) nested model more effective than weekly (7200 mins) nested models, here I skip above model.

4.4.11 Nested Weekly-Quarterly Model

Based on the comparison section proved that daily (1440 mins) nested model more effective than weekly (7200 mins) nested models, here I skip above model.

4.4.12 Nested Weekly-Yearly Model

Based on the comparison section proved that daily (1440 mins) nested model more effective than weekly (7200 mins) nested models, here I skip above model.

## Due to notice there have bias on `qt` and `yr` models after 2 years 2020 from 2018... might probably due to different reasons.

## mts.dy.wk.
ffl <- list.files('data/fx/USDJPY', pattern = 'mts.dy.wk.[0-9]{4}')
smp <- llply(ffl, function(x) {
    read_rds(paste0('data/fx/USDJPY/', x))
  })

smp_wk <- smp %>% 
  bind_rows()
smp_wk %<>% 
  .[c('index', 'open.Point.Forecast', 'high.Point.Forecast',
  'low.Point.Forecast', 'close.Point.Forecast')]
smp_wk <- join(data_m1, smp_wk)
smp_wk %<>% 
  tibble %>% 
  na.omit

## mts.dy.wk.mo
ffl <- list.files('data/fx/USDJPY', pattern = 'mts.dy.wk.mo.[0-9]{4}')
smp <- llply(ffl, function(x) {
    read_rds(paste0('data/fx/USDJPY/', x))
  })

smp_wk.mo <- smp %>% 
  bind_rows()
smp_wk.mo %<>% 
  .[c('index', 'open.Point.Forecast', 'high.Point.Forecast',
  'low.Point.Forecast', 'close.Point.Forecast')]
smp_wk.mo <- join(data_m1, smp_wk.mo)
smp_wk.mo %<>% 
  tibble %>% 
  na.omit

## mts.dy.qt.
ffl <- list.files('data/fx/USDJPY', pattern = 'mts.dy.qt.[0-9]{4}')
smp <- llply(ffl, function(x) {
    read_rds(paste0('data/fx/USDJPY/', x))
  })

smp_qt <- smp %>% 
  bind_rows()
smp_qt %<>% 
  .[c('index', 'open.Point.Forecast', 'high.Point.Forecast',
  'low.Point.Forecast', 'close.Point.Forecast')]
smp_qt <- join(data_m1, smp_qt)
smp_qt %<>% 
  tibble %>% 
  na.omit

## mts.dy.yr.
ffl <- list.files('data/fx/USDJPY', pattern = 'mts.dy.yr.[0-9]{4}')
smp <- llply(ffl, function(x) {
    read_rds(paste0('data/fx/USDJPY/', x))
  })

smp_yr <- smp %>% 
  bind_rows()
smp_yr %<>% 
  .[c('index', 'open.Point.Forecast', 'high.Point.Forecast', 
      'low.Point.Forecast', 'close.Point.Forecast')]
smp_yr <- join(data_m1, smp_yr)
smp_yr %<>% 
  tibble %>% 
  na.omit

rm(ffl, smp)

## trace and check the bias
smp_wkc <- smp_wk %>% 
    ddply(.(date = as_date(index)), summarise, 
          MSE.open = mean((open.Point.Forecast - open)^2, na.rm=TRUE), 
          MSE.high = mean((high.Point.Forecast - high)^2, na.rm=TRUE), 
          MSE.low = mean((low.Point.Forecast - low)^2, na.rm=TRUE), 
          MSE.close = mean((close.Point.Forecast - close)^2, na.rm=TRUE), 
          MSE.HLC = (MSE.high + MSE.low + MSE.close)/3, 
          MSE.OHLC = (MSE.open + MSE.high + MSE.low + MSE.close)/4, 
          n = length(index)) %>% 
    as_tibble
smp_wkc <- data.frame(model = factor('mts.dy.wk'), smp_wkc) %>% 
  tibble

smp_wk.moc <- smp_wk.mo %>% 
    ddply(.(date = as_date(index)), summarise, 
          MSE.open = mean((open.Point.Forecast - open)^2, na.rm=TRUE), 
          MSE.high = mean((high.Point.Forecast - high)^2, na.rm=TRUE), 
          MSE.low = mean((low.Point.Forecast - low)^2, na.rm=TRUE), 
          MSE.close = mean((close.Point.Forecast - close)^2, na.rm=TRUE), 
          MSE.HLC = (MSE.high + MSE.low + MSE.close)/3, 
          MSE.OHLC = (MSE.open + MSE.high + MSE.low + MSE.close)/4, 
          n = length(index)) %>% 
    as_tibble
smp_wk.moc <- data.frame(model = factor('mts.dy.wk.mo'), smp_wk.moc) %>% 
  tibble

smp_qtc <- smp_qt %>% 
    ddply(.(date = as_date(index)), summarise, 
          MSE.open = mean((open.Point.Forecast - open)^2, na.rm=TRUE), 
          MSE.high = mean((high.Point.Forecast - high)^2, na.rm=TRUE), 
          MSE.low = mean((low.Point.Forecast - low)^2, na.rm=TRUE), 
          MSE.close = mean((close.Point.Forecast - close)^2, na.rm=TRUE), 
          MSE.HLC = (MSE.high + MSE.low + MSE.close)/3, 
          MSE.OHLC = (MSE.open + MSE.high + MSE.low + MSE.close)/4, 
          n = length(index)) %>% 
    as_tibble
smp_qtc <- data.frame(model = factor('mts.dy.qt'), smp_qtc) %>% 
  tibble

smp_yrc <- smp_yr %>% 
    ddply(.(date = as_date(index)), summarise, 
          MSE.open = mean((open.Point.Forecast - open)^2, na.rm=TRUE), 
          MSE.high = mean((high.Point.Forecast - high)^2, na.rm=TRUE), 
          MSE.low = mean((low.Point.Forecast - low)^2, na.rm=TRUE), 
          MSE.close = mean((close.Point.Forecast - close)^2, na.rm=TRUE), 
          MSE.HLC = (MSE.high + MSE.low + MSE.close)/3, 
          MSE.OHLC = (MSE.open + MSE.high + MSE.low + MSE.close)/4, 
          n = length(index)) %>% 
    as_tibble
smp_yrc <- data.frame(model = factor('mts.dy.yr'), smp_yrc) %>% 
  tibble

smpp <- list(smp_wkc, smp_wk.moc, smp_qtc, smp_yrc) %>% 
  bind_rows

MSE.open <- smpp %>% 
    dplyr::select(date, model, MSE.open, n) %>% 
    spread(model, MSE.open) %>% 
  na.omit %>% 
    mutate(mean = rowMeans(
      select(., mts.dy.wk, mts.dy.wk.mo, mts.dy.qt, mts.dy.yr)))

MSE.high <- smpp %>% 
    dplyr::select(date, model, MSE.high, n) %>% 
    spread(model, MSE.high) %>% 
  na.omit %>% 
    mutate(mean = rowMeans(
      select(., mts.dy.wk, mts.dy.wk.mo, mts.dy.qt, mts.dy.yr)))

MSE.low <- smpp %>% 
    dplyr::select(date, model, MSE.low, n) %>% 
    spread(model, MSE.low) %>% 
  na.omit %>% 
    mutate(mean = rowMeans(
      select(., mts.dy.wk, mts.dy.wk.mo, mts.dy.qt, mts.dy.yr)))

MSE.close <- smpp %>% 
    dplyr::select(date, model, MSE.close, n) %>% 
    spread(model, MSE.close) %>% 
  na.omit %>% 
    mutate(mean = rowMeans(
      select(., mts.dy.wk, mts.dy.wk.mo, mts.dy.qt, mts.dy.yr)))

select(MSE.open, c(mts.dy.wk, mts.dy.wk.mo, mts.dy.qt, mts.dy.yr, mean)) %>% colMeans
#   mts.dy.wk mts.dy.wk.mo    mts.dy.qt    mts.dy.yr         mean 
#   0.2931847    0.3066926    0.6637179    3.0892483    1.0882109 
select(MSE.high, c(mts.dy.wk, mts.dy.wk.mo, mts.dy.qt, mts.dy.yr, mean)) %>% colMeans
#   mts.dy.wk mts.dy.wk.mo    mts.dy.qt    mts.dy.yr         mean 
#   0.2824914    0.3044910    0.6679225    3.1030069    1.0894780 
select(MSE.low, c(mts.dy.wk, mts.dy.wk.mo, mts.dy.qt, mts.dy.yr, mean)) %>% colMeans
#   mts.dy.wk mts.dy.wk.mo    mts.dy.qt    mts.dy.yr         mean 
#   0.2798276    0.3028962    0.6615109    3.0781766    1.0806028 
select(MSE.close, c(mts.dy.wk, mts.dy.wk.mo, mts.dy.qt, mts.dy.yr, mean)) %>% colMeans
#   mts.dy.wk mts.dy.wk.mo    mts.dy.qt    mts.dy.yr         mean 
#   0.2997343    0.2947651    0.6627861    3.0969951    1.0885702
> list(smp_wkc, smp_wk.moc, smp_qtc, smp_yrc) %>% 
  l_ply(function(x) length(x$n), .print = TRUE)
[1] 1084
[1] 1076
[1] 1084
[1] 1084

chk1 <- MSE.open %>% 
    mutate(
        diff1 = abs(mts.dy.wk - mean), 
        diff2 = abs(mts.dy.wk.mo - mean),
        diff3 = abs(mts.dy.qt - mean),
        diff4 = abs(mts.dy.yr - mean)) %>% 
    mutate_if(is.numeric, round, 4) %>% 
    data.frame

chk1a <- chk1 %>% 
  dplyr::filter(diff1 >= 0.05 | diff2 >= 0.05 | diff3 >= 0.05 | diff4 >= 0.05)
chk1a[1:100,]

4.5 Seasonal Models seasonal::seas()

# --------- eval=FALSE ---------
#sq <- seq(1 , length(data_m1$index), by = 1440)
#mts <- list()
timeID <- data_m1$index %>% 
  as_date %>% 
  unique %>% 
  sort
timeID %<>% .[. > as_date('2015-01-11')]

for (dt in timeID) {
  smp <- data_m1 %>% 
    tk_xts(silent = TRUE)
  dt %<>% as_date
  smp <- smp[paste0(dt %m-% weeks(1) + seconds(59), '/', dt + seconds(59))]
  
  mts <- smp %>% 
    msts(seasonal.periods = c(1440, 7200))
  
  mts <- llply(1:ncol(mts), function(i) {
    y <- mts[,i] %>% 
      tbats %>% 
      forecast(h = 1440) %>% 
      as_tibble
      names(y)[1] <- names(smp)[i]
      y
    }) %>% bind_rows
  
  if(is.double(mts$forecast$index[1])){
    sq <- smp %>% 
      tail(1) %>% 
      index
    if(weekdays(sq) == '土曜日'|weekdays(sq) == 'Saturday') sq <- sq + days(2)
    sq <- seq(from = sq + minutes(1), sq + days(1), by = 'min')
    mts$forecast$index <- sq
    
  } else {
    mts$forecast$index <- data_m1$index[
    (which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1):(
     which(data_m1$index == smp %>% 
             index %>% 
             xts::last()) + 1440)]
  }
  
  if (!dir.exists(paste0('data/fx/USDJPY'))) 
    dir.create(paste0('data/fx/USDJPY'))
  
  saveRDS(sets, paste0('data/fx/USDJPY/sets.wk.1440.', 
                       as_date(sets$forecast$index[1]), '.rds'))
  
  cat(paste0(
    'data/fx/USDJPY/sets.wk.1440.', 
    as_date(sets$forecast$index[1]), '.rds saved!\n'))
  }

4.6 MIDAS

Mixed Frequency Data Sampling Regression Models - The R Package midasr introduce a midas model.

4.7 GARCH-MIDAS

4.8 mcsGARCH

I have just noticed there has another GARCH model in rugarch package and then I roughly read through below articles. This multiplicative component GARCH model is different with normal GARCH model due to it includes the effects of volatility within a day. It is designate for intraday dataset.

## ------------- Simulate uv_fx() ----------------------
## uv_fx just made the model and some argument flexible.
mcsGARCH <- list()

for (dt in timeID) {
  
  for (i in seq(cr_code)) {
    
    smp <- mbase[[names(cr_code)[i]]]
    timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
    
    if (dt %in% timeID2) {
      dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
      smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
      
      mcsGARCH[[i]] <- tryCatch({llply(price_type, function(y) {
        df = uv_fx(smp, .model = 'mcsGARCH', currency = cr_code[i], 
                   price = y, .cluster = .cl)
        df = data.frame(Date = index(df$latestPrice[1]), 
                        Type = paste0(names(df$latestPrice), '.', y), 
                        df$latestPrice, df$forecastPrice, t(df$AIC))
        names(df)[4] %<>% str_replace_all('1', 'T+1')
        df
      }) %>% as_tibble %>% bind_rows}, error = function(e) NULL)
      
      if (!dir.exists(paste0('data/fx/', names(mcsGARCH[[i]])[3]))) 
        dir.create(paste0('data/fx/', names(mcsGARCH[[i]])[3]))
      
      saveRDS(mcsGARCH[[i]], paste0(
        'data/fx/', names(mcsGARCH[[i]])[3], '/mcsGARCH.', 
        unique(mcsGARCH[[i]]$Date), '.rds'))
    
      cat(paste0(
        'data/fx/', names(mcsGARCH[[i]])[3], '/mcsGARCH.', 
        unique(mcsGARCH[[i]]$Date), '.rds saved!\n'))
    }
    }; rm(i)
  }

4.9 Levy Process

5 Comparison

5.1 1 min per unit

5.1.1 Seasonal ts and msts

Here I read the saved models.

## Get all files.
fls <- paste0('data/fx/USDJPY/', list.files(
  'data/fx/USDJPY/', pattern = '^sets|^mts'))

## Shows example.
# read_rds(grep('sets', fls, value = TRUE)[1])
# read_rds(grep('mts', fls, value = TRUE)[1]) %>% as_tibble

seasonal_m <- llply(fls, function(x) {
  
  if(str_detect(x, 'sets.wk.1440.')) {
    read_rds(x)$forecast %>% 
      mutate(Model = factor('ts'), Period = factor('wk.1440'))
    
  } else if(str_detect(x, 'sets.mo.1440.')) {
    read_rds(x)$forecast %>% 
      mutate(Model = factor('ts'), Period = factor('mo.1440'))
    
  } else if(str_detect(x, 'sets.qt.1440.')) {
    read_rds(x)$forecast %>% 
      mutate(Model = factor('ts'), Period = factor('qt.1440'))
    
  } else if(str_detect(x, 'sets.yr.1440.')) {
    read_rds(x)$forecast %>% 
      mutate(Model = factor('ts'), Period = factor('yr.1440'))
    
  } else if(str_detect(x, 'sets.wk.7200.')) {
    read_rds(x)$forecast %>% 
      mutate(Model = factor('ts'), Period = factor('wk.7200'))
    
  } else if(str_detect(x, 'sets.mo.7200.')) {
    read_rds(x)$forecast %>% 
      mutate(Model = factor('ts'), Period = factor('mo.7200'))
    
  } else if(str_detect(x, 'sets.qt.7200.')) {
    read_rds(x)$forecast %>% 
      mutate(Model = factor('ts'), Period = factor('qt.7200'))
    
  } else if(str_detect(x, 'sets.yr.7200.')) {
    read_rds(x)$forecast %>% 
      mutate(Model = factor('ts'), Period = factor('yr.7200'))
    
  } else if(str_detect(x, 'mts.dy.wk.[0-9]{4}')) {
    read_rds(x) %>% 
      mutate(Model = factor('tbats'), Period = factor('dy.wk'))
    
  } else if(str_detect(x, 'mts.dy.qt.[0-9]{4}')) {
    read_rds(x) %>% 
      mutate(Model = factor('tbats'), Period = factor('dy.qt'))
    
  } else if(str_detect(x, 'mts.dy.yr.[0-9]{4}')) {
    read_rds(x) %>% 
      mutate(Model = factor('tbats'), Period = factor('dy.yr'))
    
  } else if(str_detect(x, 'mts.wk.qt.[0-9]{4}')) {
    read_rds(x) %>% 
      mutate(Model = factor('tbats'), Period = factor('wk.qt'))
    
  } else if(str_detect(x, 'mts.wk.qt.[0-9]{4}')) {
    read_rds(x) %>% 
      mutate(Model = factor('tbats'), Period = factor('wk.yr'))
    
  } else if(str_detect(x, 'mts.qt.yr.[0-9]{4}')) {
    read_rds(x) %>% 
      mutate(Model = factor('tbats'), Period = factor('qt.yr'))
    
  }  else if(str_detect(x, 'mts.dy.wk.mo.[0-9]{4}')) {
    read_rds(x) %>% 
      mutate(Model = factor('tbats'), Period = factor('dy.wk.mo'))
    
  } else if(str_detect(x, 'mts.dy.wk.mo.qt.[0-9]{4}')) {
    read_rds(x) %>% 
      mutate(Model = factor('tbats'), Period = factor('dy.wk.mo.qt'))
    
  } else if(str_detect(x, 'mts.dy.wk.mo.yr.[0-9]{4}')) {
    read_rds(x) %>% 
      mutate(Model = factor('tbats'), Period = factor('dy.wk.mo.yr'))
    
  } else {
    cat('No such files.\n')
  }
  }) %>% 
  bind_rows %>% 
  as_tibble

# seasonal_m[c('Lo.80', 
#              'close.Lo.80', 'close.Hi.80', 'close.Lo.95', 'close.Hi.95', 
#              'high.Hi.80', 'high.Lo.95', 'high.Hi.95', 
#              'high.high.Point.Forecast', 'low.Hi.80', 'low.Lo.95', 
#              'low.Hi.95', 'open.Hi.80', 'open.Lo.95', 'open.Hi.95', 
#              'open.Lo.80', 'high.Lo.80', 'low.Lo.80', 'close.Lo.80')] <- NULL

## don't use complete.cases() since there has some NA elements in ts models.
#seasonal_m <- seasonal_m[complete.cases(seasonal_m),]
#dataset with 23
write_rds(seasonal_m, 'data/fx/USDJPY/seasonal_m.rds')
seasonal_m1 <- seasonal_m
rm(seasonal_m, data_m1)

seasonal_m1 %<>% 
  .[c('index','Model','Period',
  'open.Point.Forecast','high.Point.Forecast',
  'low.Point.Forecast','close.Point.Forecast')]#,
#  'open.Point.Forecast.Hi 80','open.Point.Forecast.Lo 80',
#  'open.Point.Forecast.Lo 95','open.Point.Forecast.Hi 95',
#  'high.Point.Forecast.Lo 80','high.Point.Forecast.Hi 80',
#  'high.Point.Forecast.Lo 95','high.Point.Forecast.Hi 95',
#  'low.Point.Forecast.Lo 80','low.Point.Forecast.Hi 80',
#  'low.Point.Forecast.Lo 95','low.Point.Forecast.Hi 95',
#  'close.Point.Forecast.Lo 80','close.Point.Forecast.Hi 80',
#  'close.Point.Forecast.Lo 95','close.Point.Forecast.Hi 95')]

##
#seasonal_m <- llply(fls, function(x) {
#  read_rds(x)$forecast %>% 
#    mutate(
#      Model = case_when(
#        grepl('sets.wk.1440.', x) ~ factor('ts'), 
#        grepl('sets.mo.1440.', x) ~ factor('ts'), 
#        grepl('sets.qt.1440.', x) ~ factor('ts'), 
#        grepl('sets.yr.1440.', x) ~ factor('ts'), 
#        grepl('sets.wk.7200.', x) ~ factor('ts'), 
#        grepl('sets.mo.7200.', x) ~ factor('ts'), 
#        grepl('sets.qt.7200.', x) ~ factor('ts'), 
#        grepl('sets.yr.7200.', x) ~ factor('ts'), 
#        grepl('mts.dy.wk.[0-9]{4}', x) ~ factor('tbats'), 
#        grepl('mts.dy.wk.mo.[0-9]{4}', x) ~ factor('tbats'), 
#        grepl('mts.dy.wk.mo.qt.[0-9]{4}', x) ~ factor('tbats'), 
#        grepl('mts.dy.wk.mo.yr.[0-9]{4}', x) ~ factor('tbats'), 
#        FALSE~ stop('No such files.')), 
#      Period = factor('wk.1440'), 
#      Period = factor('mo.1440'), 
#      Period = factor('qt.1440'), 
#      Period = factor('yr.1440'), 
#      Period = factor('wk.7200'), 
#      Period = factor('mo.7200'), 
#      Period = factor('qt.7200'), 
#      Period = factor('yr.7200'), 
#      Period = factor('dy.wk'), 
#      Period = factor('dy.wk.mo'), 
#      Period = factor('dy.wk.mo.qt'), 
#      Period = factor('dy.wk.mo.yr'))
#
  #} else {
  #  stop('No such files.')
  #}
#  }) %>% 
#  bind_rows %>% 
#  as_tibble

##The last observation of Friday is Saturday 00:00:00 but not next Monday 00:00:00. Therefore the Saturday forecasted price will not be merge with Next Monday market price.
#comp %<>% .[colSums(!is.na(.)) > 0]
seasonal_m1 <- join(data_m1, seasonal_m1) %>% 
  bind_rows %>% 
  as_tibble

seasonal_m1 %<>% 
  .[c('index','Model','Period','open','high','low','close',
  'open.Point.Forecast','high.Point.Forecast',
  'low.Point.Forecast','close.Point.Forecast')]#,
#  'open.Point.Forecast.Hi 80','open.Point.Forecast.Lo 80',
#  'open.Point.Forecast.Lo 95','open.Point.Forecast.Hi 95',
#  'high.Point.Forecast.Lo 80','high.Point.Forecast.Hi 80',
#  'high.Point.Forecast.Lo 95','high.Point.Forecast.Hi 95',
#  'low.Point.Forecast.Lo 80','low.Point.Forecast.Hi 80',
#  'low.Point.Forecast.Lo 95','low.Point.Forecast.Hi 95',
#  'close.Point.Forecast.Lo 80','close.Point.Forecast.Hi 80',
#  'close.Point.Forecast.Lo 95','close.Point.Forecast.Hi 95')]

seasonal_m1 %<>% na.omit

## don't use complete.cases() since there has some NA elements in ts models.
#seasonal_m <- seasonal_m[complete.cases(seasonal_m),]
write_rds(seasonal_m1, 'data/fx/USDJPY/seasonal_m1.rds')
#zip it to be splited 99MB for each file.

## ------------------------------------------
## zip above files to be splitted small files since file sizes restriction on GitHub.
## ------------------------------------------
#dir('data/fx/USDJPY', pattern = '*.z') %>% 
#  llply(., function(x) {
#    suppressAll(unzip(paste0('data/fx/USDJPY/', x)))
#  })
seasonal_m1 <- read_rds('data/fx/USDJPY/seasonal_m1.rds')

## https://stackoverflow.com/a/52490634/3806250
#seasonal_m1[is.nan(seasonal_m1)] <- NA

5.1.1.1 Line Graph & Trend

Below graph shows the forecast price and actual price.

5.1.1.1.1 Overview
grph <- seasonal_m1 %>% 
  tidyr::unite(Model, Model:Period) %>% 
  data.table
prc <- unique(grph[, .(index, open, high, low, close)])
prc <- prc[, Model := 'Market.Price'][]
grph <- grph[, (c('open', 'high', 'low', 'close')) := NULL]
names(grph) <- c('index', 'Model', 'open', 'high', 'low', 'close')
grph <- rbind(grph, prc)
grph <- data.table(grph)[order(index)]
rm(prc)

## save dataset in data.table format
saveRDS(grph, 'data/fx/USDJPY/grph.rds')
# fwrite(data.table(grph), 'data/fx/USDJPY/grph.csv')
# write.table(data.table(grph), 'data/fx/USDJPY/grph.txt')

## https://rstudio-pubs-static.s3.amazonaws.com/31702_9c22e3d1a0c44968a4a1f9656f1800ab.html
grph_json <- rjson::toJSON(grph)
write(grph_json, 'data/fx/USDJPY/grph_json.json')

#grph_json <- fromJSON('data/fx/USDJPY/grph_json.json')
grph <- readRDS('data/fx/USDJPY/grph.rds')
data.frame(grph)[c(1:5, (nrow(grph)-5):nrow(grph)),] %>% 
  kbl('html', caption = 'Data Sample', escape = FALSE) %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
  scroll_box(width = '100%', height = '100%')
Data Sample
index Model open high low close
1 2015-01-12 00:01:00 tbats_dy.qt 118.5390 118.5614 118.5230 118.5480
2 2015-01-12 00:01:00 tbats_dy.wk 118.5390 118.5614 118.5230 118.5480
3 2015-01-12 00:01:00 tbats_dy.yr 118.5390 118.5614 118.5230 118.5480
4 2015-01-12 00:01:00 ts_mo.1440 118.5907 118.6257 118.5749 118.6095
5 2015-01-12 00:01:00 ts_mo.7200 118.5390 118.5626 118.5260 118.5480
18849595 2018-07-07 00:00:00 ts_wk.7200 110.6450 110.6435 110.5675 110.5737
18849596 2018-07-07 00:00:00 ts_wk.7200 110.6450 110.6435 110.5675 110.5737
18849597 2018-07-07 00:00:00 ts_wk.7200 110.6450 110.6435 110.5675 110.5737
18849598 2018-07-07 00:00:00 ts_wk.7200 110.6450 110.6435 110.5675 110.5737
18849599 2018-07-07 00:00:00 ts_yr.1440 110.6449 110.6492 110.5636 110.5707
18849600 2018-07-07 00:00:00 Market.Price 110.4635 110.4540 110.4770 110.4740

the dataset above has 18849600 x, 6 x dimensions.

## https://plotly.com/r/embedding-graphs-in-rmarkdown
## https://stackoverflow.com/questions/25186022/embedding-plotly-output-in-r-markdown/25192691
## 
fig <- plot_ly(grph, x = ~index, y = ~open, color = ~Model) 
fig <- fig %>% add_lines()
fig
5.1.1.1.2 Open Price
## ------------ eval = FALSE -------------------
## Due to high volume dataset and heavily ploting, here I ommit it.
grph %>% 
    group_by(Model) %>% 
    e_charts(x = index) %>% 
    e_line(open.Point.Forecast, smooth = TRUE) %>% 
  e_datazoom(
    type = 'slider', 
    toolbox = FALSE,
    bottom = -5) %>% 
  e_tooltip() %>% 
  e_title(text = 'Model', subtext = 'open.Point.Forecast', left = 'center') %>% 
  e_axis_labels(x = 'index', y = 'open.Point.Forecast') %>%
  e_x_axis(index, axisPointer = list(show = TRUE)) %>% 
  e_legend(
    orient = 'vertical', 
    type = c('scroll'), 
    #selectedMode = 'multiple', #https://echarts.apache.org/en/option.html#legend
    #selected = list('Model'), 
    left = 0, top = 80) %>% 
  e_grid(left = 150, top = 90) %>% 
  #e_theme('shine') %>% 
  e_toolbox_feature('saveAsImage', title = 'Screenshot')
## ggthemes
palettes1 <- ggthemes_data[['tableau']][['color-palettes']][['ordered-sequential']]
## https://github.com/BTJ01/ggthemes/blob/master/inst/examples/ex-scale_color_tableau.R
palettes2 <- ggthemes_data[["tableau"]][["color-palettes"]][["regular"]]

## -------------------------------
## ggthemr
## https://www.shanelynn.ie/themes-and-colours-for-r-ggplots-with-ggthemr/

#tableau_colours <- c('#1F77B4', '#FF7F0E', '#2CA02C', '#D62728', '#9467BD', '#8C564B', '#CFECF9', '#7F7F7F', '#BCBD22', '#17BECF')
tableau_colours <- palettes2$`Tableau 20`$value
names(tableau_colours) <- palettes2$`Tableau 20`$name

#names(tableau_colours) <- unique(grph$Model)

## https://colorbrewer2.org/#type=qualitative&scheme=Paired&n=12
#tableau_colours <- c('#a6cee3', '#1f78b4', '#b2df8a', '#33a02c', '#fb9a99', '#e31a1c', '#fdbf6f', '#ff7f00', '#cab2d6', '#6a3d9a', '#ffff99', '#b15928')

# you have to add a colour at the start of your palette for outlining boxes, we'll use a grey:
#tableau_colours <- c("#555555", tableau_colours)
# remove previous effects:
ggthemr_reset()

# Define colours for your figures with define_palette
tableau <- define_palette(
    swatch = tableau_colours, # colours for plotting points and bars
    ## https://stackoverflow.com/questions/7014387/whats-the-difference-between-1l-and-1
    gradient = c(lower = tableau_colours[1L], upper = tableau_colours[length(tableau_colours)]), #upper and lower colours for continuous colours
    #background = "#EEEEEE" #defining a grey-ish background 
)
# set the theme for your figures:
ggthemr(tableau)

## ------------------------
## https://stackoverflow.com/questions/34601194/change-colours-to-defined-palette-for-ggplot-objects
change_colours <- function(p, palette) {
  n <- nlevels(p$data[[deparse(p$mapping$group)]])
  tryCatch(as.character(palette), 
           error=function(e) stop('palette should be a vector of colours', call.=FALSE))
  if(n > length(palette)) stop('Not enough colours in palette.')
  pal <- function(n) palette[seq_len(n)]
  p + theme_light() + discrete_scale('colour', 'foo', pal)
}
## https://www.r-graph-gallery.com/line-chart-several-groups-ggplot2.html
p1 <- grph %>% 
  ggplot(aes(x = index, y = open, group = Model, color = Model)) + 
  geom_line() + 
  #scale_colour_gradient2_tableau(palette = names(palettes)[1]) + #first palettes list in name
  #scale_color_viridis(discrete = TRUE) + 
  labs(title = '1 min Open Price Forecasting', 
       subtitle = paste('From', range(unique(grph$index))[1L], 'to', range(unique(grph$index))[2L]), 
       caption = "Data source: fxcm") + 
  ylab('Exchange Rates USD/JPY') + 
  theme_economist() + 
  #scale_color_economist() + 
  ##scale_fill_manual(values = tableau_colours) + 
  #scale_color_brewer(tableau_colours) + 
  #scale_color_jcolors(palette = palettes2$`Tableau 20`$value) + #choose color set among palettes
  #theme(axis.text.x = element_text(hjust = c(0, 0.5, 0.5, 0.5, 1))) + 
  theme(legend.position = 'right')

#ggplotly(p1)
p1

5.1.1.1.3 High Price
rm(p1)

## https://www.r-graph-gallery.com/line-chart-several-groups-ggplot2.html
p2 <- grph %>% 
  ggplot(aes(x = index, y = high, group = Model, color = Model)) + 
  geom_line() + 
  #scale_color_viridis(discrete = TRUE) + 
  labs(title = '1 min High Price Forecasting', 
       subtitle = paste('From', range(unique(grph$index))[1L], 'to', range(unique(grph$index))[2L]), 
       caption = "Data source: fxcm") + 
  ylab('Exchange Rates USD/JPY') + 
  theme_economist() + 
  #scale_color_economist() + 
  #theme(axis.text.x = element_text(hjust = c(0, 0.5, 0.5, 0.5, 1))) + 
  theme(legend.position = 'right')

#ggplotly(p2)
p2

5.1.1.1.4 Low Price
rm(p2)

## https://www.r-graph-gallery.com/line-chart-several-groups-ggplot2.html
p3 <- grph %>% 
  ggplot(aes(x = index, y = low, group = Model, color = Model)) + 
  geom_line() + 
  #scale_color_viridis(discrete = TRUE) + 
  labs(title = '1 min Low Price Forecasting', 
       subtitle = paste('From', range(unique(grph$index))[1], 'to', range(unique(grph$index))[2]), 
       caption = "Data source: fxcm") + 
  ylab('Exchange Rates USD/JPY') + 
  theme_economist() + 
  #scale_color_economist() + 
  #theme(axis.text.x = element_text(hjust = c(0, 0.5, 0.5, 0.5, 1))) + 
  theme(legend.position = 'right')

#ggplotly(p3)
p3

5.1.1.1.5 Close Price
rm(p3)

## https://www.r-graph-gallery.com/line-chart-several-groups-ggplot2.html
p4 <- grph %>% 
  ggplot(aes(x = index, y = close, group = Model, color = Model)) + 
  geom_line() + 
  #scale_color_viridis(discrete = TRUE) + 
  labs(title = '1 min Close Price Forecasting', 
       subtitle = paste('From', range(unique(grph$index))[1], 'to', range(unique(grph$index))[2]), 
       caption = "Data source: fxcm") + 
  ylab('Exchange Rates USD/JPY') + 
  theme_economist() + 
  #scale_color_economist() + 
  #theme(axis.text.x = element_text(hjust = c(0, 0.5, 0.5, 0.5, 1))) + 
  theme(legend.position = 'right')

#ggplotly(p4)
p4

5.1.1.2 MSE Table

Below table compares the models.

rm(p4)

mse1 <- seasonal_m1 %>% 
  ddply(.(Model, Period), summarise, 
        MSE.open = mean((open.Point.Forecast - open)^2, na.rm=TRUE), 
        MSE.high = mean((high.Point.Forecast - high)^2, na.rm=TRUE), 
        MSE.low = mean((low.Point.Forecast - low)^2, na.rm=TRUE), 
        MSE.close = mean((close.Point.Forecast - close)^2, na.rm=TRUE), 
        MSE.HLC = (MSE.high + MSE.low + MSE.close)/3, 
        MSE.OHLC = (MSE.open + MSE.high + MSE.low + MSE.close)/4, 
        n = length(index)) %>% 
  as_tibble
tb6 <- mse1 %>% 
  mutate(
    MSE.open = ifelse(
      rank(MSE.open) <= 3, 
      cell_spec(
        paste0(round(MSE.open, 7), ' (rank: ', sprintf('%1.f', rank(MSE.open)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(MSE.open, 7), ' (rank: ', sprintf('%1.f', rank(MSE.open)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    MSE.high = ifelse(
      rank(MSE.high) <= 3, 
      cell_spec(
        paste0(round(MSE.high, 7), ' (rank: ', sprintf('%1.f', rank(MSE.high)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(MSE.high, 7), ' (rank: ', sprintf('%1.f', rank(MSE.high)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    MSE.low = ifelse(
      rank(MSE.low) <= 3, 
      cell_spec(
        paste0(round(MSE.low, 7), ' (rank: ', sprintf('%1.f', rank(MSE.low)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(MSE.low, 7), ' (rank: ', sprintf('%1.f', rank(MSE.low)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    MSE.close = ifelse(
      rank(MSE.close) <= 3, 
      cell_spec(
        paste0(round(MSE.close, 7), ' (rank: ', sprintf('%1.f', rank(MSE.close)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(MSE.close, 7), ' (rank: ', sprintf('%1.f', rank(MSE.close)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    MSE.HLC = ifelse(
      rank(MSE.HLC) <= 3, 
      cell_spec(
        paste0(round(MSE.HLC, 7), ' (rank: ', sprintf('%1.f', rank(MSE.HLC)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(MSE.HLC, 7), ' (rank: ', sprintf('%1.f', rank(MSE.HLC)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    MSE.OHLC = ifelse(
      rank(MSE.OHLC) <= 3, 
      cell_spec(
        paste0(round(MSE.OHLC, 7), ' (rank: ', sprintf('%1.f', rank(MSE.OHLC)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(MSE.OHLC, 7), ' (rank: ', sprintf('%1.f', rank(MSE.OHLC)), ')'), 
        'html', color = 'grey', italic = TRUE))) %>% 
  kbl('html', caption = 'MSE of Seasonal Daily 1440 minutes ETS Model (Accumulated Period from Weekly)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'DarkGrey') %>% 
  column_spec(3, background = 'Gainsboro') %>% 
  column_spec(4, background = 'LightGray') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>% 
  column_spec(7, background = 'Gainsboro') %>%  
  column_spec(8, background = 'LightGray') %>% 
  column_spec(9, background = 'LightSlateGrey') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%')#, height = '400px')

rm(mse1)
tb6
MSE of Seasonal Daily 1440 minutes ETS Model (Accumulated Period from Weekly)
Model Period MSE.open MSE.high MSE.low MSE.close MSE.HLC MSE.OHLC n
tbats dy.qt 0.5935084 (rank: 11) 0.5946396 (rank: 11) 0.593577 (rank: 11) 0.59344 (rank: 11) 0.5938855 (rank: 11) 0.5937912 (rank: 11) 1298880
tbats dy.wk 0.2331241 (rank: 1) 0.2305384 (rank: 1) 0.2331357 (rank: 1) 0.2415673 (rank: 4) 0.2350805 (rank: 2) 0.2345914 (rank: 1) 1298880
tbats dy.wk.mo 0.2585134 (rank: 6) 0.2531527 (rank: 7) 0.2511519 (rank: 6) 0.2468493 (rank: 5) 0.2503846 (rank: 6) 0.2524168 (rank: 6) 1287360
tbats dy.yr 2.992332 (rank: 12) 3.0002451 (rank: 12) 2.989127 (rank: 12) 3.0017416 (rank: 12) 2.9970379 (rank: 12) 2.9958614 (rank: 12) 1298880
ts mo.1440 0.238598 (rank: 4) 0.2372364 (rank: 4) 0.2349181 (rank: 4) 0.2378324 (rank: 3) 0.2366623 (rank: 4) 0.2371462 (rank: 4) 1298880
ts mo.7200 0.3134664 (rank: 8) 0.3146787 (rank: 8) 0.3119626 (rank: 8) 0.3142609 (rank: 7) 0.3136341 (rank: 8) 0.3135922 (rank: 8) 244800
ts qt.1440 0.2355912 (rank: 2) 0.2357561 (rank: 2) 0.2346795 (rank: 2) 0.234693 (rank: 1) 0.2350429 (rank: 1) 0.2351799 (rank: 2) 1298880
ts qt.7200 0.3156878 (rank: 9) 0.3167276 (rank: 9) 0.3144045 (rank: 9) 0.3168899 (rank: 8) 0.3160073 (rank: 9) 0.3159275 (rank: 9) 223200
ts wk.1440 0.2525562 (rank: 5) 0.2483678 (rank: 6) 0.2491352 (rank: 5) 0.2490372 (rank: 6) 0.2488467 (rank: 5) 0.2497741 (rank: 5) 1298880
ts wk.7200 0.2850686 (rank: 7) 0.2391797 (rank: 5) 0.3065442 (rank: 7) 0.32009 (rank: 9) 0.2886046 (rank: 7) 0.2877206 (rank: 7) 6494400
ts yr.1440 0.2357672 (rank: 3) 0.2359108 (rank: 3) 0.2349109 (rank: 3) 0.2348683 (rank: 2) 0.23523 (rank: 3) 0.2353643 (rank: 3) 1298880
ts yr.7200 0.3342637 (rank: 10) 0.3353777 (rank: 10) 0.3327021 (rank: 10) 0.335306 (rank: 10) 0.3344619 (rank: 10) 0.3344124 (rank: 10) 208800

from above models we know the βest model.

5.1.2 Interday Models

Here I summarize 1440 of 1 min data to be 1 day and choose the best fitted model. Below table compares the models.

# mse2 <- seasonal_m1 %>% 
#   ddply(.(Model, Period, index), summarise, 
#         MSE.open = mean((open.Point.Forecast - open)^2, na.rm=TRUE), 
#         MSE.high = mean((high.Point.Forecast - high)^2, na.rm=TRUE), 
#         MSE.low = mean((low.Point.Forecast - low)^2, na.rm=TRUE), 
#         MSE.close = mean((close.Point.Forecast - close)^2, na.rm=TRUE), 
#         MSE.HLC = (MSE.high + MSE.low + MSE.close)/3, 
#         MSE.OHLC = (MSE.open + MSE.high + MSE.low + MSE.close)/4, 
#         n = length(index)) %>% 
#   as_tibble

## https://tysonbarrett.com/jekyll/update/2019/10/06/datatable_memory/
## http://brooksandrew.github.io/simpleblog/articles/advanced-data-table/
seasonal_m1 <- data.table(seasonal_m1)
setorder(seasonal_m1, index)

open.accr <- seasonal_m1[, {
  open = open
  open.Point.Forecast = open.Point.Forecast
  .SD[, .(.N, open.mape = MAPE(open, open.Point.Forecast), 
          open.smape = SMAPE(open, open.Point.Forecast), 
          open.mse = MSE(open, open.Point.Forecast), 
          open.rmse = RMSE(open, open.Point.Forecast)), 
      by={index=as_date(index)}]}, 
  by=.(Model, Period)]

high.accr <- seasonal_m1[, {
  high = high
  high.Point.Forecast = high.Point.Forecast
  .SD[, .(.N, high.mape = MAPE(high, high.Point.Forecast), 
          high.smape = SMAPE(high, high.Point.Forecast), 
          high.mse = MSE(high, high.Point.Forecast), 
          high.rmse = RMSE(high, high.Point.Forecast)), 
      by={index=as_date(index)}]}, 
  by=.(Model, Period)]

low.accr <- seasonal_m1[, {
  low = low
  low.Point.Forecast = low.Point.Forecast
  .SD[, .(.N, low.mape = MAPE(low, low.Point.Forecast), 
          low.smape = SMAPE(low, low.Point.Forecast), 
          low.mse = MSE(low, low.Point.Forecast), 
          low.rmse = RMSE(low, low.Point.Forecast)), 
      by={index=as_date(index)}]}, 
  by=.(Model, Period)]

close.accr <- seasonal_m1[, {
  close = close
  close.Point.Forecast = close.Point.Forecast
  .SD[, .(.N, close.mape = MAPE(close, close.Point.Forecast), 
          close.smape = SMAPE(close, close.Point.Forecast), 
          close.mse = MSE(close, close.Point.Forecast), 
          close.rmse = RMSE(close, close.Point.Forecast)), 
      by={index=as_date(index)}]}, 
  by=.(Model, Period)]
open.sm <- open.accr[, list(open.mape = mean(open.mape), 
                            open.smape = mean(open.smape), 
                            open.mse = mean(open.mse), 
                            open.rmse = mean(open.rmse)), 
                       by=.(Model, Period)]

high.sm <- high.accr[, list(high.mape = mean(high.mape), 
                            high.smape = mean(high.smape), 
                            high.mse = mean(high.mse), 
                            high.rmse = mean(high.rmse)), 
                       by=.(Model, Period)]

low.sm <- low.accr[, list(low.mape = mean(low.mape), 
                          low.smape = mean(low.smape), 
                          low.mse = mean(low.mse), 
                          low.rmse = mean(low.rmse)), 
                       by=.(Model, Period)]

close.sm <- close.accr[, list(close.mape = mean(close.mape), 
                              close.smape = mean(close.smape), 
                              close.mse = mean(close.mse), 
                              close.rmse = mean(close.rmse)), 
                       by=.(Model, Period)]

daily.sm <- join_all(list(open.sm, high.sm, low.sm, close.sm)) %>% 
  tibble

saveRDS(daily.sm, 'data/fx/USDJPY/best_m.rds')

5.1.2.1 Open Price

daily.sm <- readRDS('data/fx/USDJPY/best_m.rds')

tb7 <- daily.sm %>% 
  dplyr::select(contains(c('Model', 'Period', 'open'))) %>% 
  mutate(
    open.mape = ifelse(
      rank(open.mape) <= 3, 
      cell_spec(
        paste0(round(open.mape, 7), ' (rank: ', sprintf('%1.f', rank(open.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.mape, 7), ' (rank: ', sprintf('%1.f', rank(open.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    open.smape = ifelse(
      rank(open.smape) <= 3, 
      cell_spec(
        paste0(round(open.smape, 7), ' (rank: ', sprintf('%1.f', rank(open.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.smape, 7), ' (rank: ', sprintf('%1.f', rank(open.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    open.mse = ifelse(
      rank(open.mse) <= 3, 
      cell_spec(
        paste0(round(open.mse, 7), ' (rank: ', sprintf('%1.f', rank(open.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.mse, 7), ' (rank: ', sprintf('%1.f', rank(open.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    open.rmse = ifelse(
      rank(open.rmse) <= 3, 
      cell_spec(
        paste0(round(open.rmse, 7), ' (rank: ', sprintf('%1.f', rank(open.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.rmse, 7), ' (rank: ', sprintf('%1.f', rank(open.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE))) %>% 
  kbl('html', caption = 'Comparison of Models (1 min Open Price Summarised to 1 Day per Unit)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'DarkGrey') %>% 
  column_spec(3, background = 'Gainsboro') %>% 
  column_spec(4, background = 'LightGray') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>%   
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%')#, height = '400px')

tb7
Comparison of Models (1 min Open Price Summarised to 1 Day per Unit)
Model Period open.mape open.smape open.mse open.rmse
tbats dy.qt 0.0038487 (rank: 8) 0.0038663 (rank: 8) 0.6615488 (rank: 11) 0.4836051 (rank: 8)
tbats dy.wk 0.0031178 (rank: 2) 0.0031203 (rank: 2) 0.2951857 (rank: 4) 0.4022059 (rank: 1)
tbats dy.yr 0.0078141 (rank: 12) 0.007929 (rank: 12) 3.0602275 (rank: 12) 0.9279223 (rank: 12)
ts mo.1440 0.0031302 (rank: 4) 0.0031321 (rank: 4) 0.2895257 (rank: 3) 0.4044655 (rank: 4)
ts mo.7200 0.0041186 (rank: 10) 0.0041147 (rank: 10) 0.425753 (rank: 9) 0.5564735 (rank: 10)
ts qt.1440 0.0031176 (rank: 1) 0.0031195 (rank: 1) 0.2870498 (rank: 1) 0.4030116 (rank: 2)
ts qt.7200 0.004058 (rank: 9) 0.0040546 (rank: 9) 0.42255 (rank: 8) 0.5479559 (rank: 9)
ts wk.1440 0.0032485 (rank: 7) 0.0032503 (rank: 7) 0.3038581 (rank: 5) 0.4183746 (rank: 7)
ts wk.7200 0.0031907 (rank: 6) 0.0031914 (rank: 6) 0.3388586 (rank: 7) 0.412083 (rank: 6)
ts yr.1440 0.0031196 (rank: 3) 0.0031215 (rank: 3) 0.2872197 (rank: 2) 0.4032139 (rank: 3)
ts yr.7200 0.0042881 (rank: 11) 0.0042843 (rank: 11) 0.4553046 (rank: 10) 0.5785254 (rank: 11)
tbats dy.wk.mo 0.0031517 (rank: 5) 0.003155 (rank: 5) 0.3068028 (rank: 6) 0.4058541 (rank: 5)

5.1.2.2 High Price

tb8 <- daily.sm %>% 
  dplyr::select(contains(c('Model', 'Period', 'high'))) %>% 
  mutate(
    high.mape = ifelse(
      rank(high.mape) <= 3, 
      cell_spec(
        paste0(round(high.mape, 7), ' (rank: ', sprintf('%1.f', rank(high.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.mape, 7), ' (rank: ', sprintf('%1.f', rank(high.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    high.smape = ifelse(
      rank(high.smape) <= 3, 
      cell_spec(
        paste0(round(high.smape, 7), ' (rank: ', sprintf('%1.f', rank(high.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.smape, 7), ' (rank: ', sprintf('%1.f', rank(high.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    high.mse = ifelse(
      rank(high.mse) <= 3, 
      cell_spec(
        paste0(round(high.mse, 7), ' (rank: ', sprintf('%1.f', rank(high.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.mse, 7), ' (rank: ', sprintf('%1.f', rank(high.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    high.rmse = ifelse(
      rank(high.rmse) <= 3, 
      cell_spec(
        paste0(round(high.rmse, 7), ' (rank: ', sprintf('%1.f', rank(high.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.rmse, 7), ' (rank: ', sprintf('%1.f', rank(high.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE))) %>% 
  kbl('html', caption = 'Comparison of Models (1 min High Price Summarised to 1 Day per Unit)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'DarkGrey') %>% 
  column_spec(3, background = 'Gainsboro') %>% 
  column_spec(4, background = 'LightGray') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>%   
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%')#, height = '400px')

tb8
Comparison of Models (1 min High Price Summarised to 1 Day per Unit)
Model Period high.mape high.smape high.mse high.rmse
tbats dy.qt 0.0038673 (rank: 8) 0.0038852 (rank: 8) 0.6658388 (rank: 11) 0.4855776 (rank: 8)
tbats dy.wk 0.0030783 (rank: 1) 0.0030807 (rank: 1) 0.2846739 (rank: 1) 0.397453 (rank: 1)
tbats dy.yr 0.0078297 (rank: 12) 0.0079453 (rank: 12) 3.0739678 (rank: 12) 0.9298084 (rank: 12)
ts mo.1440 0.0031371 (rank: 5) 0.0031392 (rank: 5) 0.2918493 (rank: 4) 0.4052568 (rank: 5)
ts mo.7200 0.0041905 (rank: 10) 0.0041868 (rank: 10) 0.4366597 (rank: 9) 0.5650381 (rank: 10)
ts qt.1440 0.0031227 (rank: 3) 0.0031248 (rank: 3) 0.288908 (rank: 2) 0.4035778 (rank: 3)
ts qt.7200 0.004129 (rank: 9) 0.0041259 (rank: 9) 0.4333607 (rank: 8) 0.5565739 (rank: 9)
ts wk.1440 0.0032312 (rank: 7) 0.0032334 (rank: 7) 0.3002029 (rank: 6) 0.4159632 (rank: 7)
ts wk.7200 0.0031119 (rank: 2) 0.0031138 (rank: 2) 0.2986969 (rank: 5) 0.401548 (rank: 2)
ts yr.1440 0.0031252 (rank: 4) 0.0031273 (rank: 4) 0.2890714 (rank: 3) 0.4038346 (rank: 4)
ts yr.7200 0.0043671 (rank: 11) 0.0043636 (rank: 11) 0.467057 (rank: 10) 0.5881937 (rank: 11)
tbats dy.wk.mo 0.0031592 (rank: 6) 0.0031622 (rank: 6) 0.3054827 (rank: 7) 0.4065748 (rank: 6)

5.1.2.3 Low Price

tb9 <- daily.sm %>% 
  dplyr::select(contains(c('Model', 'Period', 'low'))) %>% 
  mutate(
    low.mape = ifelse(
      rank(low.mape) <= 3, 
      cell_spec(
        paste0(round(low.mape, 7), ' (rank: ', sprintf('%1.f', rank(low.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.mape, 7), ' (rank: ', sprintf('%1.f', rank(low.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    low.smape = ifelse(
      rank(low.smape) <= 3, 
      cell_spec(
        paste0(round(low.smape, 7), ' (rank: ', sprintf('%1.f', rank(low.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.smape, 7), ' (rank: ', sprintf('%1.f', rank(low.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    low.mse = ifelse(
      rank(low.mse) <= 3, 
      cell_spec(
        paste0(round(low.mse, 7), ' (rank: ', sprintf('%1.f', rank(low.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.mse, 7), ' (rank: ', sprintf('%1.f', rank(low.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    low.rmse = ifelse(
      rank(low.rmse) <= 3, 
      cell_spec(
        paste0(round(low.rmse, 7), ' (rank: ', sprintf('%1.f', rank(low.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.rmse, 7), ' (rank: ', sprintf('%1.f', rank(low.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE))) %>% 
  kbl('html', caption = 'Comparison of Models (1 min Open Price Summarised to 1 Day per Unit)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'DarkGrey') %>% 
  column_spec(3, background = 'Gainsboro') %>% 
  column_spec(4, background = 'LightGray') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>%   
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%')#, height = '400px')

tb9
Comparison of Models (1 min Open Price Summarised to 1 Day per Unit)
Model Period low.mape low.smape low.mse low.rmse
tbats dy.qt 0.0038604 (rank: 8) 0.0038777 (rank: 8) 0.6593377 (rank: 11) 0.4847373 (rank: 8)
tbats dy.wk 0.0030658 (rank: 1) 0.0030678 (rank: 1) 0.2820305 (rank: 1) 0.3962719 (rank: 1)
tbats dy.yr 0.0078086 (rank: 12) 0.0079229 (rank: 12) 3.0492512 (rank: 12) 0.9272861 (rank: 12)
ts mo.1440 0.0031155 (rank: 3) 0.0031171 (rank: 3) 0.2833452 (rank: 4) 0.4027251 (rank: 3)
ts mo.7200 0.0040769 (rank: 10) 0.0040725 (rank: 10) 0.4221267 (rank: 9) 0.5517966 (rank: 10)
ts qt.1440 0.0031147 (rank: 2) 0.0031162 (rank: 2) 0.2829726 (rank: 2) 0.4026439 (rank: 2)
ts qt.7200 0.0039968 (rank: 9) 0.0039929 (rank: 9) 0.4190357 (rank: 8) 0.5412921 (rank: 9)
ts wk.1440 0.0032298 (rank: 6) 0.0032312 (rank: 6) 0.2968221 (rank: 5) 0.4159053 (rank: 6)
ts wk.7200 0.0032465 (rank: 7) 0.0032471 (rank: 7) 0.3657361 (rank: 7) 0.4186519 (rank: 7)
ts yr.1440 0.0031173 (rank: 4) 0.0031188 (rank: 4) 0.2831797 (rank: 3) 0.4029436 (rank: 4)
ts yr.7200 0.0042393 (rank: 11) 0.004235 (rank: 11) 0.4522995 (rank: 10) 0.5732734 (rank: 11)
tbats dy.wk.mo 0.0031814 (rank: 5) 0.0031842 (rank: 5) 0.3030913 (rank: 6) 0.4089394 (rank: 5)

5.1.2.4 Close Price

tb10 <- daily.sm %>% 
  dplyr::select(contains(c('Model', 'Period', 'close'))) %>% 
  mutate(
    close.mape = ifelse(
      rank(close.mape) <= 3, 
      cell_spec(
        paste0(round(close.mape, 7), ' (rank: ', sprintf('%1.f', rank(close.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.mape, 7), ' (rank: ', sprintf('%1.f', rank(close.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    close.smape = ifelse(
      rank(close.smape) <= 3, 
      cell_spec(
        paste0(round(close.smape, 7), ' (rank: ', sprintf('%1.f', rank(close.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.smape, 7), ' (rank: ', sprintf('%1.f', rank(close.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    close.mse = ifelse(
      rank(close.mse) <= 3, 
      cell_spec(
        paste0(round(close.mse, 7), ' (rank: ', sprintf('%1.f', rank(close.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.mse, 7), ' (rank: ', sprintf('%1.f', rank(close.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    close.rmse = ifelse(
      rank(close.rmse) <= 3, 
      cell_spec(
        paste0(round(close.rmse, 7), ' (rank: ', sprintf('%1.f', rank(close.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.rmse, 7), ' (rank: ', sprintf('%1.f', rank(close.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE))) %>% 
  kbl('html', caption = 'Comparison of Models (1 min Close Price Summarised to 1 Day per Unit)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'DarkGrey') %>% 
  column_spec(3, background = 'Gainsboro') %>% 
  column_spec(4, background = 'LightGray') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>%   
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%')#, height = '400px')

tb10
Comparison of Models (1 min Close Price Summarised to 1 Day per Unit)
Model Period close.mape close.smape close.mse close.rmse
tbats dy.qt 0.0038503 (rank: 8) 0.0038679 (rank: 8) 0.6610232 (rank: 11) 0.4837561 (rank: 8)
tbats dy.wk 0.003145 (rank: 5) 0.0031473 (rank: 5) 0.3015154 (rank: 6) 0.4057309 (rank: 5)
tbats dy.yr 0.0078135 (rank: 12) 0.0079289 (rank: 12) 3.0682874 (rank: 12) 0.9280099 (rank: 12)
ts mo.1440 0.0031304 (rank: 4) 0.003132 (rank: 4) 0.2874381 (rank: 3) 0.4044561 (rank: 4)
ts mo.7200 0.0041607 (rank: 10) 0.0041564 (rank: 10) 0.4379246 (rank: 9) 0.5616704 (rank: 10)
ts qt.1440 0.0031164 (rank: 1) 0.0031182 (rank: 1) 0.284739 (rank: 1) 0.4028578 (rank: 2)
ts qt.7200 0.0040893 (rank: 9) 0.0040855 (rank: 9) 0.4356525 (rank: 8) 0.5524039 (rank: 9)
ts wk.1440 0.0032319 (rank: 7) 0.0032337 (rank: 7) 0.2995034 (rank: 5) 0.4162795 (rank: 7)
ts wk.7200 0.0031979 (rank: 6) 0.0031966 (rank: 6) 0.3632592 (rank: 7) 0.4118763 (rank: 6)
ts yr.1440 0.0031187 (rank: 2) 0.0031205 (rank: 2) 0.2849251 (rank: 2) 0.403099 (rank: 3)
ts yr.7200 0.0043391 (rank: 11) 0.0043348 (rank: 11) 0.4701278 (rank: 10) 0.5850767 (rank: 11)
tbats dy.wk.mo 0.0031204 (rank: 3) 0.0031234 (rank: 3) 0.2948921 (rank: 4) 0.4018679 (rank: 1)

5.1.2.5 Summary

tb11 <- daily.sm %>% 
  mutate(
    open.mape = ifelse(
      rank(open.mape) <= 3, 
      cell_spec(
        paste0(round(open.mape, 7), ' (rank: ', sprintf('%1.f', rank(open.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.mape, 7), ' (rank: ', sprintf('%1.f', rank(open.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    open.smape = ifelse(
      rank(open.smape) <= 3, 
      cell_spec(
        paste0(round(open.smape, 7), ' (rank: ', sprintf('%1.f', rank(open.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.smape, 7), ' (rank: ', sprintf('%1.f', rank(open.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    open.mse = ifelse(
      rank(open.mse) <= 3, 
      cell_spec(
        paste0(round(open.mse, 7), ' (rank: ', sprintf('%1.f', rank(open.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.mse, 7), ' (rank: ', sprintf('%1.f', rank(open.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    open.rmse = ifelse(
      rank(open.rmse) <= 3, 
      cell_spec(
        paste0(round(open.rmse, 7), ' (rank: ', sprintf('%1.f', rank(open.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.rmse, 7), ' (rank: ', sprintf('%1.f', rank(open.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    
    high.mape = ifelse(
      rank(high.mape) <= 3, 
      cell_spec(
        paste0(round(high.mape, 7), ' (rank: ', sprintf('%1.f', rank(high.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.mape, 7), ' (rank: ', sprintf('%1.f', rank(high.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    high.smape = ifelse(
      rank(high.smape) <= 3, 
      cell_spec(
        paste0(round(high.smape, 7), ' (rank: ', sprintf('%1.f', rank(high.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.smape, 7), ' (rank: ', sprintf('%1.f', rank(high.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    high.mse = ifelse(
      rank(high.mse) <= 3, 
      cell_spec(
        paste0(round(high.mse, 7), ' (rank: ', sprintf('%1.f', rank(high.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.mse, 7), ' (rank: ', sprintf('%1.f', rank(high.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    high.rmse = ifelse(
      rank(high.rmse) <= 3, 
      cell_spec(
        paste0(round(high.rmse, 7), ' (rank: ', sprintf('%1.f', rank(high.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.rmse, 7), ' (rank: ', sprintf('%1.f', rank(high.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    
    low.mape = ifelse(
      rank(low.mape) <= 3, 
      cell_spec(
        paste0(round(low.mape, 7), ' (rank: ', sprintf('%1.f', rank(low.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.mape, 7), ' (rank: ', sprintf('%1.f', rank(low.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    low.smape = ifelse(
      rank(low.smape) <= 3, 
      cell_spec(
        paste0(round(low.smape, 7), ' (rank: ', sprintf('%1.f', rank(low.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.smape, 7), ' (rank: ', sprintf('%1.f', rank(low.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    low.mse = ifelse(
      rank(low.mse) <= 3, 
      cell_spec(
        paste0(round(low.mse, 7), ' (rank: ', sprintf('%1.f', rank(low.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.mse, 7), ' (rank: ', sprintf('%1.f', rank(low.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    low.rmse = ifelse(
      rank(low.rmse) <= 3, 
      cell_spec(
        paste0(round(low.rmse, 7), ' (rank: ', sprintf('%1.f', rank(low.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.rmse, 7), ' (rank: ', sprintf('%1.f', rank(low.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    
    close.mape = ifelse(
      rank(close.mape) <= 3, 
      cell_spec(
        paste0(round(close.mape, 7), ' (rank: ', sprintf('%1.f', rank(close.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.mape, 7), ' (rank: ', sprintf('%1.f', rank(close.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    close.smape = ifelse(
      rank(close.smape) <= 3, 
      cell_spec(
        paste0(round(close.smape, 7), ' (rank: ', sprintf('%1.f', rank(close.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.smape, 7), ' (rank: ', sprintf('%1.f', rank(close.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    close.mse = ifelse(
      rank(close.mse) <= 3, 
      cell_spec(
        paste0(round(close.mse, 7), ' (rank: ', sprintf('%1.f', rank(close.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.mse, 7), ' (rank: ', sprintf('%1.f', rank(close.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    close.rmse = ifelse(
      rank(close.rmse) <= 3, 
      cell_spec(
        paste0(round(close.rmse, 7), ' (rank: ', sprintf('%1.f', rank(close.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.rmse, 7), ' (rank: ', sprintf('%1.f', rank(close.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE))) %>% 
  kbl('html', caption = 'Comparison of Models (1 min summarised to 1 day per unit)', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'DarkGrey') %>% 
  #column_spec(3, background = 'LightSlateGrey') %>% 
  column_spec(3, background = 'LightGray') %>% 
  column_spec(4, background = 'Gainsboro') %>% 
  column_spec(5, background = 'LightGray') %>%   
  column_spec(6, background = 'Gainsboro') %>% 
  column_spec(7, background = 'LightGray') %>% 
  column_spec(8, background = 'Gainsboro') %>% 
  column_spec(9, background = 'LightGray') %>%   
  column_spec(10, background = 'Gainsboro') %>% 
  column_spec(11, background = 'LightGray') %>% 
  column_spec(12, background = 'Gainsboro') %>% 
  column_spec(13, background = 'LightGray') %>%   
  column_spec(14, background = 'Gainsboro') %>% 
  column_spec(15, background = 'LightGray') %>% 
  column_spec(16, background = 'Gainsboro') %>% 
  column_spec(17, background = 'LightGray') %>%   
  column_spec(18, background = 'Gainsboro') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%')#, height = '400px')

tb11
Comparison of Models (1 min summarised to 1 day per unit)
Model Period open.mape open.smape open.mse open.rmse high.mape high.smape high.mse high.rmse low.mape low.smape low.mse low.rmse close.mape close.smape close.mse close.rmse
tbats dy.qt 0.0038487 (rank: 8) 0.0038663 (rank: 8) 0.6615488 (rank: 11) 0.4836051 (rank: 8) 0.0038673 (rank: 8) 0.0038852 (rank: 8) 0.6658388 (rank: 11) 0.4855776 (rank: 8) 0.0038604 (rank: 8) 0.0038777 (rank: 8) 0.6593377 (rank: 11) 0.4847373 (rank: 8) 0.0038503 (rank: 8) 0.0038679 (rank: 8) 0.6610232 (rank: 11) 0.4837561 (rank: 8)
tbats dy.wk 0.0031178 (rank: 2) 0.0031203 (rank: 2) 0.2951857 (rank: 4) 0.4022059 (rank: 1) 0.0030783 (rank: 1) 0.0030807 (rank: 1) 0.2846739 (rank: 1) 0.397453 (rank: 1) 0.0030658 (rank: 1) 0.0030678 (rank: 1) 0.2820305 (rank: 1) 0.3962719 (rank: 1) 0.003145 (rank: 5) 0.0031473 (rank: 5) 0.3015154 (rank: 6) 0.4057309 (rank: 5)
tbats dy.yr 0.0078141 (rank: 12) 0.007929 (rank: 12) 3.0602275 (rank: 12) 0.9279223 (rank: 12) 0.0078297 (rank: 12) 0.0079453 (rank: 12) 3.0739678 (rank: 12) 0.9298084 (rank: 12) 0.0078086 (rank: 12) 0.0079229 (rank: 12) 3.0492512 (rank: 12) 0.9272861 (rank: 12) 0.0078135 (rank: 12) 0.0079289 (rank: 12) 3.0682874 (rank: 12) 0.9280099 (rank: 12)
ts mo.1440 0.0031302 (rank: 4) 0.0031321 (rank: 4) 0.2895257 (rank: 3) 0.4044655 (rank: 4) 0.0031371 (rank: 5) 0.0031392 (rank: 5) 0.2918493 (rank: 4) 0.4052568 (rank: 5) 0.0031155 (rank: 3) 0.0031171 (rank: 3) 0.2833452 (rank: 4) 0.4027251 (rank: 3) 0.0031304 (rank: 4) 0.003132 (rank: 4) 0.2874381 (rank: 3) 0.4044561 (rank: 4)
ts mo.7200 0.0041186 (rank: 10) 0.0041147 (rank: 10) 0.425753 (rank: 9) 0.5564735 (rank: 10) 0.0041905 (rank: 10) 0.0041868 (rank: 10) 0.4366597 (rank: 9) 0.5650381 (rank: 10) 0.0040769 (rank: 10) 0.0040725 (rank: 10) 0.4221267 (rank: 9) 0.5517966 (rank: 10) 0.0041607 (rank: 10) 0.0041564 (rank: 10) 0.4379246 (rank: 9) 0.5616704 (rank: 10)
ts qt.1440 0.0031176 (rank: 1) 0.0031195 (rank: 1) 0.2870498 (rank: 1) 0.4030116 (rank: 2) 0.0031227 (rank: 3) 0.0031248 (rank: 3) 0.288908 (rank: 2) 0.4035778 (rank: 3) 0.0031147 (rank: 2) 0.0031162 (rank: 2) 0.2829726 (rank: 2) 0.4026439 (rank: 2) 0.0031164 (rank: 1) 0.0031182 (rank: 1) 0.284739 (rank: 1) 0.4028578 (rank: 2)
ts qt.7200 0.004058 (rank: 9) 0.0040546 (rank: 9) 0.42255 (rank: 8) 0.5479559 (rank: 9) 0.004129 (rank: 9) 0.0041259 (rank: 9) 0.4333607 (rank: 8) 0.5565739 (rank: 9) 0.0039968 (rank: 9) 0.0039929 (rank: 9) 0.4190357 (rank: 8) 0.5412921 (rank: 9) 0.0040893 (rank: 9) 0.0040855 (rank: 9) 0.4356525 (rank: 8) 0.5524039 (rank: 9)
ts wk.1440 0.0032485 (rank: 7) 0.0032503 (rank: 7) 0.3038581 (rank: 5) 0.4183746 (rank: 7) 0.0032312 (rank: 7) 0.0032334 (rank: 7) 0.3002029 (rank: 6) 0.4159632 (rank: 7) 0.0032298 (rank: 6) 0.0032312 (rank: 6) 0.2968221 (rank: 5) 0.4159053 (rank: 6) 0.0032319 (rank: 7) 0.0032337 (rank: 7) 0.2995034 (rank: 5) 0.4162795 (rank: 7)
ts wk.7200 0.0031907 (rank: 6) 0.0031914 (rank: 6) 0.3388586 (rank: 7) 0.412083 (rank: 6) 0.0031119 (rank: 2) 0.0031138 (rank: 2) 0.2986969 (rank: 5) 0.401548 (rank: 2) 0.0032465 (rank: 7) 0.0032471 (rank: 7) 0.3657361 (rank: 7) 0.4186519 (rank: 7) 0.0031979 (rank: 6) 0.0031966 (rank: 6) 0.3632592 (rank: 7) 0.4118763 (rank: 6)
ts yr.1440 0.0031196 (rank: 3) 0.0031215 (rank: 3) 0.2872197 (rank: 2) 0.4032139 (rank: 3) 0.0031252 (rank: 4) 0.0031273 (rank: 4) 0.2890714 (rank: 3) 0.4038346 (rank: 4) 0.0031173 (rank: 4) 0.0031188 (rank: 4) 0.2831797 (rank: 3) 0.4029436 (rank: 4) 0.0031187 (rank: 2) 0.0031205 (rank: 2) 0.2849251 (rank: 2) 0.403099 (rank: 3)
ts yr.7200 0.0042881 (rank: 11) 0.0042843 (rank: 11) 0.4553046 (rank: 10) 0.5785254 (rank: 11) 0.0043671 (rank: 11) 0.0043636 (rank: 11) 0.467057 (rank: 10) 0.5881937 (rank: 11) 0.0042393 (rank: 11) 0.004235 (rank: 11) 0.4522995 (rank: 10) 0.5732734 (rank: 11) 0.0043391 (rank: 11) 0.0043348 (rank: 11) 0.4701278 (rank: 10) 0.5850767 (rank: 11)
tbats dy.wk.mo 0.0031517 (rank: 5) 0.003155 (rank: 5) 0.3068028 (rank: 6) 0.4058541 (rank: 5) 0.0031592 (rank: 6) 0.0031622 (rank: 6) 0.3054827 (rank: 7) 0.4065748 (rank: 6) 0.0031814 (rank: 5) 0.0031842 (rank: 5) 0.3030913 (rank: 6) 0.4089394 (rank: 5) 0.0031204 (rank: 3) 0.0031234 (rank: 3) 0.2948921 (rank: 4) 0.4018679 (rank: 1)

Above table summarized the daily mape, smape, mse and rmse values and then summarized again the models (which is nested summarize due to daily settlement), we can interpret from above table :

  • Weekly or 7200 mins length’s dataset with msts(seasonal.periods = c(1440, 7200)) %>% tbats %>% forecast(h = 1440).
  • Quarterly length’s dataset with tk_ts(frequency = 1440) %>% forecast(h=1440).
  • Annum length’s dataset with tk_ts(frequency = 1440) %>% forecast(h=1440).

5.1.3 Miscellaneous

5.1.3.1 Best Model

#best_model <- seasonal_m1 %>% 
#    ddply(.(Model, Period), summarize, 
#        mape = MAPE(open, open.Point.Forecast), 
#        smape = SMAPE(open, open.Point.Forecast), 
#        mse = MSE(open, open.Point.Forecast), 
#        rmse = RMSE(open, open.Point.Forecast))

## https://tysonbarrett.com/jekyll/update/2019/10/06/datatable_memory/
## http://brooksandrew.github.io/simpleblog/articles/advanced-data-table/
if(!is.data.table(seasonal_m1)) seasonal_m1 <- data.table(seasonal_m1)
setorder(seasonal_m1, index)

m.op <- seasonal_m1[, {
  open = open
  open.Point.Forecast = open.Point.Forecast
  .SD[, .(.N, open.mape = MAPE(open, open.Point.Forecast), 
          open.smape = SMAPE(open, open.Point.Forecast), 
          open.mse = MSE(open, open.Point.Forecast), 
          open.rmse = RMSE(open, open.Point.Forecast)), 
      by=.(Model, Period)]}][order(Model, Period), ]

m.hi <- seasonal_m1[, {
  high = high
  high.Point.Forecast = high.Point.Forecast
  .SD[, .(.N, high.mape = MAPE(high, high.Point.Forecast), 
          high.smape = SMAPE(high, high.Point.Forecast), 
          high.mse = MSE(high, high.Point.Forecast), 
          high.rmse = RMSE(high, high.Point.Forecast)), 
      by=.(Model, Period)]}][order(Model, Period), ]

m.lo <- seasonal_m1[, {
  low = low
  low.Point.Forecast = low.Point.Forecast
  .SD[, .(.N, low.mape = MAPE(low, low.Point.Forecast), 
          low.smape = SMAPE(low, low.Point.Forecast), 
          low.mse = MSE(low, low.Point.Forecast), 
          low.rmse = RMSE(low, low.Point.Forecast)), 
      by=.(Model, Period)]}][order(Model, Period), ]

m.cl <- seasonal_m1[, {
  close = close
  close.Point.Forecast = close.Point.Forecast
  .SD[, .(.N, close.mape = MAPE(close, close.Point.Forecast), 
          close.smape = SMAPE(close, close.Point.Forecast), 
          close.mse = MSE(close, close.Point.Forecast), 
          close.rmse = RMSE(close, close.Point.Forecast)), 
      by=.(Model, Period)]}][order(Model, Period), ]

best_model <- join_all(list(m.op, m.hi, m.lo, m.cl)) %>% tibble
saveRDS(best_model, 'data/fx/USDJPY/best_m_daily.rds')
rm(m.op, m.hi, m.lo, m.cl)
best_model <- readRDS('data/fx/USDJPY/best_m_daily.rds')

tb12 <- best_model %>% 
  mutate(
    open.mape = ifelse(
      rank(open.mape) <= 3, 
      cell_spec(
        paste0(round(open.mape, 7), ' (rank: ', sprintf('%1.f', rank(open.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.mape, 7), ' (rank: ', sprintf('%1.f', rank(open.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    open.smape = ifelse(
      rank(open.smape) <= 3, 
      cell_spec(
        paste0(round(open.smape, 7), ' (rank: ', sprintf('%1.f', rank(open.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.smape, 7), ' (rank: ', sprintf('%1.f', rank(open.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    open.mse = ifelse(
      rank(open.mse) <= 3, 
      cell_spec(
        paste0(round(open.mse, 7), ' (rank: ', sprintf('%1.f', rank(open.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.mse, 7), ' (rank: ', sprintf('%1.f', rank(open.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    open.rmse = ifelse(
      rank(open.rmse) <= 3, 
      cell_spec(
        paste0(round(open.rmse, 7), ' (rank: ', sprintf('%1.f', rank(open.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(open.rmse, 7), ' (rank: ', sprintf('%1.f', rank(open.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    
    high.mape = ifelse(
      rank(high.mape) <= 3, 
      cell_spec(
        paste0(round(high.mape, 7), ' (rank: ', sprintf('%1.f', rank(high.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.mape, 7), ' (rank: ', sprintf('%1.f', rank(high.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    high.smape = ifelse(
      rank(high.smape) <= 3, 
      cell_spec(
        paste0(round(high.smape, 7), ' (rank: ', sprintf('%1.f', rank(high.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.smape, 7), ' (rank: ', sprintf('%1.f', rank(high.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    high.mse = ifelse(
      rank(high.mse) <= 3, 
      cell_spec(
        paste0(round(high.mse, 7), ' (rank: ', sprintf('%1.f', rank(high.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.mse, 7), ' (rank: ', sprintf('%1.f', rank(high.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    high.rmse = ifelse(
      rank(high.rmse) <= 3, 
      cell_spec(
        paste0(round(high.rmse, 7), ' (rank: ', sprintf('%1.f', rank(high.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(high.rmse, 7), ' (rank: ', sprintf('%1.f', rank(high.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    
    low.mape = ifelse(
      rank(low.mape) <= 3, 
      cell_spec(
        paste0(round(low.mape, 7), ' (rank: ', sprintf('%1.f', rank(low.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.mape, 7), ' (rank: ', sprintf('%1.f', rank(low.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    low.smape = ifelse(
      rank(low.smape) <= 3, 
      cell_spec(
        paste0(round(low.smape, 7), ' (rank: ', sprintf('%1.f', rank(low.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.smape, 7), ' (rank: ', sprintf('%1.f', rank(low.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    low.mse = ifelse(
      rank(low.mse) <= 3, 
      cell_spec(
        paste0(round(low.mse, 7), ' (rank: ', sprintf('%1.f', rank(low.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.mse, 7), ' (rank: ', sprintf('%1.f', rank(low.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    low.rmse = ifelse(
      rank(low.rmse) <= 3, 
      cell_spec(
        paste0(round(low.rmse, 7), ' (rank: ', sprintf('%1.f', rank(low.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(low.rmse, 7), ' (rank: ', sprintf('%1.f', rank(low.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    
    close.mape = ifelse(
      rank(close.mape) <= 3, 
      cell_spec(
        paste0(round(close.mape, 7), ' (rank: ', sprintf('%1.f', rank(close.mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.mape, 7), ' (rank: ', sprintf('%1.f', rank(close.mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    close.smape = ifelse(
      rank(close.smape) <= 3, 
      cell_spec(
        paste0(round(close.smape, 7), ' (rank: ', sprintf('%1.f', rank(close.smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.smape, 7), ' (rank: ', sprintf('%1.f', rank(close.smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    close.mse = ifelse(
      rank(close.mse) <= 3, 
      cell_spec(
        paste0(round(close.mse, 7), ' (rank: ', sprintf('%1.f', rank(close.mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.mse, 7), ' (rank: ', sprintf('%1.f', rank(close.mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    close.rmse = ifelse(
      rank(close.rmse) <= 3, 
      cell_spec(
        paste0(round(close.rmse, 7), ' (rank: ', sprintf('%1.f', rank(close.rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(close.rmse, 7), ' (rank: ', sprintf('%1.f', rank(close.rmse)), ')'), 
        'html', color = 'grey', italic = TRUE))) %>% 
  kbl('html', caption = 'Comparison of Models', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'DarkGrey') %>% 
  column_spec(3, background = 'LightSlateGrey') %>% 
  column_spec(4, background = 'LightGray') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>%   
  column_spec(7, background = 'Gainsboro') %>% 
  column_spec(8, background = 'LightGray') %>% 
  column_spec(9, background = 'Gainsboro') %>% 
  column_spec(10, background = 'LightGray') %>%   
  column_spec(11, background = 'Gainsboro') %>% 
  column_spec(12, background = 'LightGray') %>% 
  column_spec(13, background = 'Gainsboro') %>% 
  column_spec(14, background = 'LightGray') %>%   
  column_spec(15, background = 'Gainsboro') %>% 
  column_spec(16, background = 'LightGray') %>% 
  column_spec(17, background = 'Gainsboro') %>% 
  column_spec(18, background = 'LightGray') %>%   
  column_spec(19, background = 'Gainsboro') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%')#, height = '400px')

tb12
Comparison of Models
Model Period N open.mape open.smape open.mse open.rmse high.mape high.smape high.mse high.rmse low.mape low.smape low.mse low.rmse close.mape close.smape close.mse close.rmse
tbats dy.qt 1298880 0.0035608 (rank: 10) 0.0035773 (rank: 10) 0.5935084 (rank: 11) 0.770395 (rank: 11) 0.0035672 (rank: 10) 0.0035837 (rank: 10) 0.5946396 (rank: 11) 0.7711288 (rank: 11) 0.0035692 (rank: 10) 0.0035856 (rank: 10) 0.593577 (rank: 11) 0.7704395 (rank: 11) 0.0035606 (rank: 10) 0.0035771 (rank: 10) 0.59344 (rank: 11) 0.7703506 (rank: 11)
tbats dy.wk 1298880 0.002821 (rank: 1) 0.0028228 (rank: 1) 0.2331241 (rank: 1) 0.4828292 (rank: 1) 0.0027999 (rank: 1) 0.0028016 (rank: 1) 0.2305384 (rank: 1) 0.4801442 (rank: 1) 0.0028014 (rank: 1) 0.0028031 (rank: 1) 0.2331357 (rank: 1) 0.4828412 (rank: 1) 0.002839 (rank: 1) 0.002841 (rank: 1) 0.2415673 (rank: 4) 0.4914949 (rank: 4)
tbats dy.wk.mo 1287360 0.0028932 (rank: 5) 0.0028962 (rank: 5) 0.2585134 (rank: 6) 0.5084421 (rank: 6) 0.002889 (rank: 6) 0.0028914 (rank: 6) 0.2531527 (rank: 7) 0.5031428 (rank: 7) 0.0029032 (rank: 5) 0.0029056 (rank: 5) 0.2511519 (rank: 6) 0.5011506 (rank: 6) 0.0028635 (rank: 4) 0.0028661 (rank: 4) 0.2468493 (rank: 5) 0.4968393 (rank: 5)
tbats dy.yr 1298880 0.0075387 (rank: 12) 0.0076525 (rank: 12) 2.992332 (rank: 12) 1.7298358 (rank: 12) 0.0075476 (rank: 12) 0.0076617 (rank: 12) 3.0002451 (rank: 12) 1.7321216 (rank: 12) 0.0075415 (rank: 12) 0.0076552 (rank: 12) 2.989127 (rank: 12) 1.7289092 (rank: 12) 0.0075423 (rank: 12) 0.0076565 (rank: 12) 3.0017416 (rank: 12) 1.7325535 (rank: 12)
ts mo.1440 1298880 0.002871 (rank: 4) 0.0028723 (rank: 4) 0.238598 (rank: 4) 0.4884649 (rank: 4) 0.0028638 (rank: 5) 0.0028652 (rank: 5) 0.2372364 (rank: 4) 0.4870692 (rank: 4) 0.0028605 (rank: 3) 0.0028618 (rank: 3) 0.2349181 (rank: 4) 0.4846835 (rank: 4) 0.0028733 (rank: 5) 0.0028745 (rank: 5) 0.2378324 (rank: 3) 0.4876807 (rank: 3)
ts mo.7200 244800 0.0034764 (rank: 8) 0.0034756 (rank: 8) 0.3134664 (rank: 8) 0.5598807 (rank: 8) 0.0035018 (rank: 8) 0.0035011 (rank: 8) 0.3146787 (rank: 8) 0.5609623 (rank: 8) 0.0034669 (rank: 8) 0.0034659 (rank: 8) 0.3119626 (rank: 8) 0.5585361 (rank: 8) 0.0034906 (rank: 8) 0.0034897 (rank: 8) 0.3142609 (rank: 7) 0.5605898 (rank: 7)
ts qt.1440 1298880 0.0028558 (rank: 2) 0.0028571 (rank: 2) 0.2355912 (rank: 2) 0.4853773 (rank: 2) 0.0028566 (rank: 3) 0.002858 (rank: 3) 0.2357561 (rank: 2) 0.4855472 (rank: 2) 0.0028598 (rank: 2) 0.0028611 (rank: 2) 0.2346795 (rank: 2) 0.4844374 (rank: 2) 0.0028572 (rank: 2) 0.0028585 (rank: 2) 0.234693 (rank: 1) 0.4844512 (rank: 1)
ts qt.7200 223200 0.0034844 (rank: 9) 0.0034841 (rank: 9) 0.3156878 (rank: 9) 0.561861 (rank: 9) 0.0035078 (rank: 9) 0.0035075 (rank: 9) 0.3167276 (rank: 9) 0.5627856 (rank: 9) 0.0034754 (rank: 9) 0.003475 (rank: 9) 0.3144045 (rank: 9) 0.5607179 (rank: 9) 0.0034988 (rank: 9) 0.0034984 (rank: 9) 0.3168899 (rank: 8) 0.5629298 (rank: 8)
ts wk.1440 1298880 0.0029887 (rank: 7) 0.0029899 (rank: 7) 0.2525562 (rank: 5) 0.5025497 (rank: 5) 0.0029757 (rank: 7) 0.0029772 (rank: 7) 0.2483678 (rank: 6) 0.4983651 (rank: 6) 0.0029796 (rank: 7) 0.0029807 (rank: 7) 0.2491352 (rank: 5) 0.4991344 (rank: 5) 0.0029779 (rank: 7) 0.0029791 (rank: 7) 0.2490372 (rank: 6) 0.4990362 (rank: 6)
ts wk.7200 6494400 0.0029027 (rank: 6) 0.002903 (rank: 6) 0.2850686 (rank: 7) 0.5339181 (rank: 7) 0.0028179 (rank: 2) 0.0028195 (rank: 2) 0.2391797 (rank: 5) 0.48906 (rank: 5) 0.00295 (rank: 6) 0.0029496 (rank: 6) 0.3065442 (rank: 7) 0.5536644 (rank: 7) 0.0029287 (rank: 6) 0.0029266 (rank: 6) 0.32009 (rank: 9) 0.565765 (rank: 9)
ts yr.1440 1298880 0.0028579 (rank: 3) 0.0028593 (rank: 3) 0.2357672 (rank: 3) 0.4855587 (rank: 3) 0.0028589 (rank: 4) 0.0028603 (rank: 4) 0.2359108 (rank: 3) 0.4857065 (rank: 3) 0.0028625 (rank: 4) 0.0028637 (rank: 4) 0.2349109 (rank: 3) 0.484676 (rank: 3) 0.0028594 (rank: 3) 0.0028607 (rank: 3) 0.2348683 (rank: 2) 0.4846321 (rank: 2)
ts yr.7200 208800 0.0036239 (rank: 11) 0.0036236 (rank: 11) 0.3342637 (rank: 10) 0.5781554 (rank: 10) 0.0036485 (rank: 11) 0.0036482 (rank: 11) 0.3353777 (rank: 10) 0.5791181 (rank: 10) 0.0036111 (rank: 11) 0.0036106 (rank: 11) 0.3327021 (rank: 10) 0.5768033 (rank: 10) 0.0036356 (rank: 11) 0.0036352 (rank: 11) 0.335306 (rank: 10) 0.5790561 (rank: 10)

Above table summarized the total observations with mape, smape, mse and rmse values (which is nested summarize not daily settlement), we can interpret from above table :

  • Weekly or 7200 mins length’s dataset with msts(seasonal.periods = c(1440, 7200)) %>% tbats %>% forecast(h = 1440).
  • Quarterly length’s dataset with tk_ts(frequency = 1440) %>% forecast(h=1440).
  • Annum length’s dataset with tk_ts(frequency = 1440) %>% forecast(h=1440).

5.1.3.2 Sarima

##Below model use open price dataset where contain 7200 mins and forecast 1440 mins.
fit_ts <- readRDS('data/fx/USDJPY/sarima_ts_sample.rds')
#fr_ts <- forecast(fit_ts, h = 1440)
fr_ts <- readRDS('data/fx/USDJPY/sarima_frts_sample.rds')
fr_ts.sample <- readRDS('data/fx/USDJPY/fr_ts.sample.wk.1440.2015-01-12.rds')

##Below model use open price dataset where contain 7200 mins and forecast nested 60mins & 1440 mins.
fit_msts <- readRDS('data/fx/USDJPY/sarima_msts_sample.rds')
fr_msts <- readRDS('data/fx/USDJPY/sarima_frmsts_sample.rds')
fr_msts.sample <- readRDS('data/fx/USDJPY/fr_msts.sample.wk.1440.2015-01-12.rds')

Due to heavily calculation on sarima models, here I only use 1st week from 2015-01-12 00:01:00 to from 2015-01-13 00:00:00` calculate.

cmp1 <- join(fr_ts.sample, fr_msts.sample) %>% 
  as_tibble

lst1 <- list.files('data/fx/USDJPY', pattern = '^mts.*.2015-01-12.rds$')
cmp2 <- llply(lst1, function(x) {
    readRDS(paste0('data/fx/USDJPY/', x)) %>% 
    dplyr::select(contains(c('index', 'open.Point.Forecast'))) %>% .[,1:2]
  })
names(cmp2) <- str_replace_all(lst1, '.[1-9].*', '')
cmp2 %<>% ldply %>% 
  as_tibble %>% 
  spread(.id, open.Point.Forecast)
cmp2 <- data.frame(open = cmp1$open, cmp2) %>% 
  as_tibble %>% 
  .[c(2:1, 3:ncol(.))]

lst2 <- list.files('data/fx/USDJPY', pattern = '^sets.*.2015-01-12.rds$')
cmp3 <- llply(lst2, function(x) {
    readRDS(paste0('data/fx/USDJPY/', x))$forecast %>% 
    dplyr::select(contains(c('index', 'open.Point.Forecast'))) %>% .[1:1440,1:2]
  })
names(cmp3) <- substr(lst2, 1, 12) #manual filter characters
cmp3 %<>% ldply %>% 
  as_tibble %>% 
  spread(.id, open.Point.Forecast)
cmp3 <- data.frame(open = cmp1$open, cmp3) %>% 
  as_tibble %>% 
  .[c(2:1, 3:ncol(.))]

## ------------------------
cmp1 <- data.frame(
  Model = c('sarima_ts', 'sarima_msts'), 
  n = nrow(cmp1), 
  mape = c(MAPE(cmp1$open, cmp1$sarima_ts), 
           MAPE(cmp1$open, cmp1$sarima_msts)), 
  smape = c(SMAPE(cmp1$open, cmp1$sarima_ts), 
            SMAPE(cmp1$open, cmp1$sarima_msts)), 
  mse = c(MSE(cmp1$open, cmp1$sarima_ts), 
          MSE(cmp1$open, cmp1$sarima_msts)), 
  rmse = c(RMSE(cmp1$open, cmp1$sarima_ts), 
           RMSE(cmp1$open, cmp1$sarima_msts))) %>% 
  tibble

cmp2 <- data.frame(
  Model = names(cmp2)[3:ncol(cmp2)], 
  n = nrow(cmp2), 
  mape = c(MAPE(cmp2$open, cmp2$mts.dy.qt), 
           MAPE(cmp2$open, cmp2$mts.dy.wk), 
           MAPE(cmp2$open, cmp2$mts.dy.wk.mo), 
           MAPE(cmp2$open, cmp2$mts.dy.yr)), 
  smape = c(SMAPE(cmp2$open, cmp2$mts.dy.qt), 
            SMAPE(cmp2$open, cmp2$mts.dy.wk), 
            SMAPE(cmp2$open, cmp2$mts.dy.wk.mo), 
            SMAPE(cmp2$open, cmp2$mts.dy.yr)), 
  mse = c(MSE(cmp2$open, cmp2$mts.dy.qt), 
          MSE(cmp2$open, cmp2$mts.dy.wk), 
          MSE(cmp2$open, cmp2$mts.dy.wk.mo), 
          MSE(cmp2$open, cmp2$mts.dy.yr)), 
  rmse = c(RMSE(cmp2$open, cmp2$mts.dy.qt), 
           RMSE(cmp2$open, cmp2$mts.dy.wk), 
           RMSE(cmp2$open, cmp2$mts.dy.wk.mo), 
           RMSE(cmp2$open, cmp2$mts.dy.yr))) %>% 
  tibble

cmp3 <- data.frame(
  Model = names(cmp3)[3:ncol(cmp3)], 
  n = nrow(cmp3), 
  mape = c(MAPE(cmp3$open, cmp3$sets.mo.1440), 
           MAPE(cmp3$open, cmp3$sets.mo.7200), 
           MAPE(cmp3$open, cmp3$sets.qt.1440), 
           MAPE(cmp3$open, cmp3$sets.qt.7200), 
           MAPE(cmp3$open, cmp3$sets.wk.1440), 
           MAPE(cmp3$open, cmp3$sets.wk.7200), 
           MAPE(cmp3$open, cmp3$sets.yr.1440), 
           MAPE(cmp3$open, cmp3$sets.yr.7200)), 
  smape = c(SMAPE(cmp3$open, cmp3$sets.mo.1440), 
            SMAPE(cmp3$open, cmp3$sets.mo.7200), 
            SMAPE(cmp3$open, cmp3$sets.qt.1440), 
            SMAPE(cmp3$open, cmp3$sets.qt.7200), 
            SMAPE(cmp3$open, cmp3$sets.wk.1440), 
            SMAPE(cmp3$open, cmp3$sets.wk.7200), 
            SMAPE(cmp3$open, cmp3$sets.yr.1440), 
            SMAPE(cmp3$open, cmp3$sets.yr.7200)), 
  mse = c(MSE(cmp3$open, cmp3$sets.mo.1440), 
          MSE(cmp3$open, cmp3$sets.mo.7200), 
          MSE(cmp3$open, cmp3$sets.qt.1440), 
          MSE(cmp3$open, cmp3$sets.qt.7200), 
          MSE(cmp3$open, cmp3$sets.wk.1440), 
          MSE(cmp3$open, cmp3$sets.wk.7200), 
          MSE(cmp3$open, cmp3$sets.yr.1440), 
          MSE(cmp3$open, cmp3$sets.yr.7200)), 
  rmse = c(RMSE(cmp3$open, cmp3$sets.mo.1440), 
           RMSE(cmp3$open, cmp3$sets.mo.7200), 
           RMSE(cmp3$open, cmp3$sets.qt.1440), 
           RMSE(cmp3$open, cmp3$sets.qt.7200), 
           RMSE(cmp3$open, cmp3$sets.wk.1440), 
           RMSE(cmp3$open, cmp3$sets.wk.7200), 
           RMSE(cmp3$open, cmp3$sets.yr.1440), 
           RMSE(cmp3$open, cmp3$sets.yr.7200))) %>% 
  tibble

cmp <- bind_rows(cmp1, cmp2, cmp3) %>% 
  as_tibble
tb13 <- cmp %>% 
  mutate(
    mape = ifelse(
      rank(mape) <= 3, 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mape, 7), ' (rank: ', sprintf('%1.f', rank(mape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    smape = ifelse(
      rank(smape) <= 3, 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(smape, 7), ' (rank: ', sprintf('%1.f', rank(smape)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    mse = ifelse(
      rank(mse) <= 3, 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(mse, 7), ' (rank: ', sprintf('%1.f', rank(mse)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    rmse = ifelse(
      rank(rmse) <= 3, 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(rmse, 7), ' (rank: ', sprintf('%1.f', rank(rmse)), ')'), 
        'html', color = 'grey', italic = TRUE))) %>% 
  kbl('html', caption = 'Comparison of Sarima_ts & Sarima_msts Models etc', escape = FALSE) %>% 
  ## https://www.w3schools.com/cssref/css_colors.asp
  row_spec(0, background = 'DimGrey') %>% 
  column_spec(1, background = 'CornflowerBlue') %>% 
  column_spec(2, background = 'DarkGrey') %>% 
  column_spec(3, background = 'Gainsboro') %>% 
  column_spec(4, background = 'LightGray') %>% 
  column_spec(5, background = 'Gainsboro') %>% 
  column_spec(6, background = 'LightGray') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kable_material(full_width = FALSE) %>% ##`full_width = FALSE` will auto adjust every single columns width to fit the table full width.
  scroll_box(width = '100%')#, height = '400px')

tb13
Comparison of Sarima_ts & Sarima_msts Models etc
Model n mape smape mse rmse
sarima_ts 1440 0.0046041 (rank: 12) 0.0045896 (rank: 12) 0.4452853 (rank: 12) 0.667297 (rank: 12)
sarima_msts 1440 0.0046041 (rank: 12) 0.0045896 (rank: 12) 0.4452853 (rank: 12) 0.667297 (rank: 12)
mts.dy.qt 1440 0.0024737 (rank: 6) 0.0024726 (rank: 6) 0.1155722 (rank: 6) 0.3399591 (rank: 6)
mts.dy.wk 1440 0.0024737 (rank: 6) 0.0024726 (rank: 6) 0.1155722 (rank: 6) 0.3399591 (rank: 6)
mts.dy.wk.mo 1440 NA (rank: 14) NA (rank: 14) NA (rank: 14) NA (rank: 14)
mts.dy.yr 1440 0.0024737 (rank: 6) 0.0024726 (rank: 6) 0.1155722 (rank: 6) 0.3399591 (rank: 6)
sets.mo.1440 1440 0.0026197 (rank: 10) 0.0026221 (rank: 10) 0.1198407 (rank: 10) 0.3461801 (rank: 10)
sets.mo.7200 1440 0.0024737 (rank: 2) 0.0024726 (rank: 2) 0.1155722 (rank: 2) 0.3399591 (rank: 2)
sets.qt.1440 1440 0.0026197 (rank: 10) 0.0026221 (rank: 10) 0.1198407 (rank: 10) 0.3461801 (rank: 10)
sets.qt.7200 1440 0.0024737 (rank: 2) 0.0024726 (rank: 2) 0.1155722 (rank: 2) 0.3399591 (rank: 2)
sets.wk.1440 1440 0.0026197 (rank: 10) 0.0026221 (rank: 10) 0.1198407 (rank: 10) 0.3461801 (rank: 10)
sets.wk.7200 1440 0.0024737 (rank: 2) 0.0024726 (rank: 2) 0.1155722 (rank: 2) 0.3399591 (rank: 2)
sets.yr.1440 1440 0.0026197 (rank: 10) 0.0026221 (rank: 10) 0.1198407 (rank: 10) 0.3461801 (rank: 10)
sets.yr.7200 1440 0.0024737 (rank: 2) 0.0024726 (rank: 2) 0.1155722 (rank: 2) 0.3399591 (rank: 2)

Application of auto.arima() on both ts() and msts() seasonal datasets compare the ts() and msts() sarima models.

5.2 1 day per unit

5.2.1 Interday ETS Model

Below I recall the ETS models for interday price prediction in previous paper for comparison.

ets.fls <- list.files('data', pattern = '^[A-Z]{3}\\.[A-Za-z]{4}')
ETS.MSE <- llply(ets.fls, function(x) {
    nm <- x %>% 
      str_replace_all('.rds', '') %>% 
      str_split_fixed('\\.', 2) %>% 
      as_data_frame
    names(nm) <- c('Model', 'Type')
    
    y <- paste0('data/', x) %>% 
      read_rds
    
    data.frame(nm, y) %>% as_tibble
  }) %>% bind_rows %>% 
  dplyr::select(Date, Model,Type, Point.Forecast, forClose, 
                USDJPY.Open, USDJPY.High, USDJPY.Low, USDJPY.Close)

ETS.MSE %<>% mutate(
    MSE.1 = case_when(
        substr(Type, 1, 2) == 'Op' ~ mean((Point.Forecast - USDJPY.Open)^2, 
                                          na.rm = TRUE), 
        substr(Type, 1, 2) == 'Hi' ~ mean((Point.Forecast - USDJPY.High)^2, 
                                          na.rm = TRUE), 
        substr(Type, 1, 2) == 'Mn' ~ mean((Point.Forecast - (USDJPY.High + USDJPY.Low)/2)^2, na.rm = TRUE), 
        substr(Type, 1, 2) == 'Lo' ~ mean((Point.Forecast - USDJPY.Low)^2, 
                                          na.rm = TRUE), 
        substr(Type, 1, 2) == 'Cl' ~ mean((Point.Forecast - USDJPY.Close)^2, 
                                          na.rm = TRUE)), 
    MSE.2 = case_when(
        substr(Type, 3, 4) == 'Op' ~ mean((Point.Forecast - USDJPY.Open)^2, 
                                          na.rm = TRUE), 
        substr(Type, 3, 4) == 'Hi' ~ mean((Point.Forecast - USDJPY.High)^2, 
                                          na.rm = TRUE), 
        substr(Type, 3, 4) == 'Mn' ~ mean((Point.Forecast - (USDJPY.High + USDJPY.Low)/2)^2, na.rm = TRUE), 
        substr(Type, 3, 4) == 'Lo' ~ mean((Point.Forecast - USDJPY.Low)^2, 
                                          na.rm = TRUE), 
        substr(Type, 3, 4) == 'Cl' ~ mean((Point.Forecast - USDJPY.Close)^2, 
                                          na.rm = TRUE)))

ETS.MSE %<>% 
    ddply(.(Model, Type), summarise, 
          MSE.1 = mean(MSE.1, na.rm=TRUE), 
          MSE.2 = mean(MSE.2, na.rm=TRUE))

tb14 <- ETS.MSE %>% mutate(
    MSE.1 = ifelse(
      rank(MSE.1) <= 3, 
      cell_spec(
        paste0(round(MSE.1, 7), ' (rank: ', sprintf('%1.f', rank(MSE.1)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(MSE.1, 7), ' (rank: ', sprintf('%1.f', rank(MSE.1)), ')'), 
        'html', color = 'grey', italic = TRUE)), 
    MSE.2 = ifelse(
      rank(MSE.2) <= 3, 
      cell_spec(
        paste0(round(MSE.2, 7), ' (rank: ', sprintf('%1.f', rank(MSE.2)), ')'), 
        'html', color = 'darkgoldenrod', bold = TRUE), 
      cell_spec(
        paste0(round(MSE.2, 7), ' (rank: ', sprintf('%1.f', rank(MSE.2)), ')'), 
        'html', color = 'grey', italic = TRUE))) %>% 
  kbl('html', caption = 'MSE of daily Opened and Closed Transaction Orders', escape = FALSE) %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  kableExtra::group_rows('AAN', 1, 25, label_row_css = 'background-color: #e68a00; color: #fff;') %>%
  kableExtra::group_rows('AAZ', 26, 50, label_row_css = 'background-color: #ff0000; color: #fff;') %>%
  kableExtra::group_rows('ANN', 51, 75, label_row_css = 'background-color: #bf80ff; color: #fff;') %>%
  kableExtra::group_rows('ANZ', 76, 100, label_row_css = 'background-color: #66ff33; color: #fff;') %>%
  kableExtra::group_rows('AZN', 101, 125, label_row_css = 'background-color: #6666ff; color: #fff;') %>%
  kableExtra::group_rows('AZZ', 126, 150, label_row_css = 'background-color: #66e0ff; color: #fff;') %>%
  kableExtra::group_rows('MAN', 151, 175, label_row_css = 'background-color:#0066ff; color: #fff;') %>%
  kableExtra::group_rows('MAZ', 176, 200, label_row_css = 'background-color: #ff9900; color: #fff;') %>%
  kableExtra::group_rows('MMN', 201, 225, label_row_css = 'background-color: #33ff33; color: #fff;') %>%
  kableExtra::group_rows('MMZ', 226, 250, label_row_css = 'background-color: #339966; color: #fff;') %>%
  kableExtra::group_rows('MNN', 251, 275, label_row_css = 'background-color: #5900b3; color: #fff;') %>%
  kableExtra::group_rows('MNZ', 276, 300, label_row_css = 'background-color: #269900; color: #fff;') %>%
  kableExtra::group_rows('MZN', 301, 325, label_row_css = 'background-color: #808000; color: #fff;') %>%
  kableExtra::group_rows('MZZ', 326, 350, label_row_css = 'background-color: #3399ff; color: #fff;') %>%
  kableExtra::group_rows('ZAN', 351, 375, label_row_css = 'background-color: #003380; color: #fff;') %>%
  kableExtra::group_rows('ZAZ', 376, 400, label_row_css = 'background-color: #804d00; color: #fff;') %>%
  kableExtra::group_rows('ZMN', 401, 425, label_row_css = 'background-color: #d279d2; color: #fff;') %>%
  kableExtra::group_rows('ZMZ', 426, 450, label_row_css = 'background-color: #666; color: #fff;') %>%
  kableExtra::group_rows('ZNN', 451, 475, label_row_css = 'background-color: #ff3377; color: #fff;') %>%
  kableExtra::group_rows('ZNZ', 476, 500, label_row_css = 'background-color: #993399; color: #fff;') %>%
  kableExtra::group_rows('ZZN', 501, 525, label_row_css = 'background-color: #00a3cc; color: #fff;') %>%
  kableExtra::group_rows('ZZZ', 526, 550, label_row_css = 'background-color: #e60000; color: #fff;') %>%
  scroll_box(width = '100%', height = '400px')

tb14
MSE of daily Opened and Closed Transaction Orders
Model Type MSE.1 MSE.2
AAN
AAN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
AAN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
AAN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
AAN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
AAN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
AAN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
AAN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
AAN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
AAN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
AAN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
AAN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
AAN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
AAN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
AAN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
AAN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
AAN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
AAN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
AAN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
AAN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
AAN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
AAN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
AAN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
AAN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
AAN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
AAN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
AAZ
AAZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
AAZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
AAZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
AAZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
AAZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
AAZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
AAZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
AAZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
AAZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
AAZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
AAZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
AAZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
AAZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
AAZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
AAZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
AAZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
AAZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
AAZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
AAZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
AAZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
AAZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
AAZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
AAZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
AAZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
AAZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
ANN
ANN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
ANN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
ANN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
ANN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
ANN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
ANN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
ANN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
ANN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
ANN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
ANN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
ANN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
ANN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
ANN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
ANN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
ANN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
ANN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
ANN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
ANN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
ANN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
ANN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
ANN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
ANN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
ANN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
ANN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
ANN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
ANZ
ANZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
ANZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
ANZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
ANZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
ANZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
ANZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
ANZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
ANZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
ANZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
ANZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
ANZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
ANZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
ANZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
ANZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
ANZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
ANZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
ANZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
ANZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
ANZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
ANZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
ANZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
ANZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
ANZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
ANZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
ANZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
AZN
AZN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
AZN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
AZN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
AZN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
AZN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
AZN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
AZN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
AZN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
AZN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
AZN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
AZN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
AZN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
AZN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
AZN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
AZN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
AZN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
AZN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
AZN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
AZN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
AZN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
AZN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
AZN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
AZN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
AZN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
AZN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
AZZ
AZZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
AZZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
AZZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
AZZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
AZZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
AZZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
AZZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
AZZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
AZZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
AZZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
AZZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
AZZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
AZZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
AZZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
AZZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
AZZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
AZZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
AZZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
AZZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
AZZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
AZZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
AZZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
AZZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
AZZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
AZZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
MAN
MAN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
MAN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
MAN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
MAN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
MAN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
MAN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
MAN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
MAN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
MAN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
MAN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
MAN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
MAN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
MAN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
MAN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
MAN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
MAN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
MAN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
MAN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
MAN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
MAN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
MAN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
MAN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
MAN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
MAN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
MAN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
MAZ
MAZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
MAZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
MAZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
MAZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
MAZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
MAZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
MAZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
MAZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
MAZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
MAZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
MAZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
MAZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
MAZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
MAZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
MAZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
MAZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
MAZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
MAZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
MAZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
MAZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
MAZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
MAZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
MAZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
MAZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
MAZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
MMN
MMN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
MMN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
MMN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
MMN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
MMN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
MMN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
MMN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
MMN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
MMN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
MMN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
MMN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
MMN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
MMN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
MMN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
MMN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
MMN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
MMN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
MMN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
MMN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
MMN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
MMN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
MMN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
MMN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
MMN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
MMN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
MMZ
MMZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
MMZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
MMZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
MMZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
MMZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
MMZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
MMZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
MMZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
MMZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
MMZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
MMZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
MMZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
MMZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
MMZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
MMZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
MMZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
MMZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
MMZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
MMZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
MMZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
MMZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
MMZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
MMZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
MMZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
MMZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
MNN
MNN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
MNN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
MNN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
MNN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
MNN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
MNN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
MNN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
MNN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
MNN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
MNN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
MNN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
MNN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
MNN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
MNN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
MNN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
MNN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
MNN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
MNN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
MNN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
MNN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
MNN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
MNN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
MNN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
MNN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
MNN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
MNZ
MNZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
MNZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
MNZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
MNZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
MNZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
MNZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
MNZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
MNZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
MNZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
MNZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
MNZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
MNZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
MNZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
MNZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
MNZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
MNZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
MNZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
MNZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
MNZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
MNZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
MNZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
MNZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
MNZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
MNZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
MNZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
MZN
MZN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
MZN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
MZN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
MZN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
MZN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
MZN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
MZN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
MZN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
MZN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
MZN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
MZN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
MZN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
MZN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
MZN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
MZN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
MZN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
MZN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
MZN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
MZN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
MZN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
MZN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
MZN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
MZN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
MZN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
MZN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
MZZ
MZZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
MZZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
MZZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
MZZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
MZZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
MZZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
MZZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
MZZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
MZZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
MZZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
MZZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
MZZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
MZZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
MZZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
MZZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
MZZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
MZZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
MZZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
MZZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
MZZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
MZZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
MZZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
MZZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
MZZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
MZZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
ZAN
ZAN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
ZAN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
ZAN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
ZAN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
ZAN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
ZAN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
ZAN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
ZAN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
ZAN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
ZAN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
ZAN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
ZAN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
ZAN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
ZAN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
ZAN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
ZAN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
ZAN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
ZAN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
ZAN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
ZAN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
ZAN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
ZAN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
ZAN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
ZAN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
ZAN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
ZAZ
ZAZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
ZAZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
ZAZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
ZAZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
ZAZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
ZAZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
ZAZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
ZAZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
ZAZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
ZAZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
ZAZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
ZAZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
ZAZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
ZAZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
ZAZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
ZAZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
ZAZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
ZAZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
ZAZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
ZAZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
ZAZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
ZAZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
ZAZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
ZAZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
ZAZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
ZMN
ZMN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
ZMN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
ZMN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
ZMN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
ZMN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
ZMN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
ZMN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
ZMN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
ZMN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
ZMN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
ZMN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
ZMN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
ZMN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
ZMN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
ZMN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
ZMN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
ZMN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
ZMN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
ZMN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
ZMN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
ZMN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
ZMN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
ZMN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
ZMN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
ZMN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
ZMZ
ZMZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
ZMZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
ZMZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
ZMZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
ZMZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
ZMZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
ZMZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
ZMZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
ZMZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
ZMZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
ZMZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
ZMZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
ZMZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
ZMZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
ZMZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
ZMZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
ZMZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
ZMZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
ZMZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
ZMZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
ZMZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
ZMZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
ZMZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
ZMZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
ZMZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
ZNN
ZNN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
ZNN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
ZNN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
ZNN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
ZNN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
ZNN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
ZNN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
ZNN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
ZNN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
ZNN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
ZNN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
ZNN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
ZNN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
ZNN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
ZNN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
ZNN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
ZNN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
ZNN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
ZNN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
ZNN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
ZNN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
ZNN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
ZNN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
ZNN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
ZNN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
ZNZ
ZNZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
ZNZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
ZNZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
ZNZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
ZNZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
ZNZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
ZNZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
ZNZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
ZNZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
ZNZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
ZNZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
ZNZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
ZNZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
ZNZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
ZNZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
ZNZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
ZNZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
ZNZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
ZNZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
ZNZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
ZNZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
ZNZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
ZNZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
ZNZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
ZNZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
ZZN
ZZN ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
ZZN ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
ZZN ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
ZZN ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
ZZN ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
ZZN HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
ZZN HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
ZZN HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
ZZN HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
ZZN HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
ZZN LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
ZZN LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
ZZN LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
ZZN LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
ZZN LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
ZZN MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
ZZN MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
ZZN MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
ZZN MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
ZZN MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
ZZN OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
ZZN OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
ZZN OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
ZZN OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
ZZN OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)
ZZZ
ZZZ ClCl 0.467076 (rank: 166) 0.467076 (rank: 166)
ZZZ ClHi 0.467076 (rank: 166) 0.8097381 (rank: 386)
ZZZ ClLo 0.467076 (rank: 166) 1.0410108 (rank: 496)
ZZZ ClMn 0.467076 (rank: 166) 0.6447018 (rank: 276)
ZZZ ClOp 0.467076 (rank: 166) 0.4635132 (rank: 56)
ZZZ HiCl 0.8097381 (rank: 386) 0.467076 (rank: 166)
ZZZ HiHi 0.8097381 (rank: 386) 0.8097381 (rank: 386)
ZZZ HiLo 0.8097381 (rank: 386) 1.0410108 (rank: 496)
ZZZ HiMn 0.8097381 (rank: 386) 0.6447018 (rank: 276)
ZZZ HiOp 0.8097381 (rank: 386) 0.4635132 (rank: 56)
ZZZ LoCl 1.0410108 (rank: 496) 0.467076 (rank: 166)
ZZZ LoHi 1.0410108 (rank: 496) 0.8097381 (rank: 386)
ZZZ LoLo 1.0410108 (rank: 496) 1.0410108 (rank: 496)
ZZZ LoMn 1.0410108 (rank: 496) 0.6447018 (rank: 276)
ZZZ LoOp 1.0410108 (rank: 496) 0.4635132 (rank: 56)
ZZZ MnCl 0.6447018 (rank: 276) 0.467076 (rank: 166)
ZZZ MnHi 0.6447018 (rank: 276) 0.8097381 (rank: 386)
ZZZ MnLo 0.6447018 (rank: 276) 1.0410108 (rank: 496)
ZZZ MnMn 0.6447018 (rank: 276) 0.6447018 (rank: 276)
ZZZ MnOp 0.6447018 (rank: 276) 0.4635132 (rank: 56)
ZZZ OpCl 0.4635132 (rank: 56) 0.467076 (rank: 166)
ZZZ OpHi 0.4635132 (rank: 56) 0.8097381 (rank: 386)
ZZZ OpLo 0.4635132 (rank: 56) 1.0410108 (rank: 496)
ZZZ OpMn 0.4635132 (rank: 56) 0.6447018 (rank: 276)
ZZZ OpOp 0.4635132 (rank: 56) 0.4635132 (rank: 56)

Source : Binary.com Interview Q1 (Extention)

From above MSE comparison with intraday-dataset, we know that the intraday data will be more accurate than just daily dataset.

5.2.2 Interday auto.arima Model

ar.fls <- list.files('data', pattern = '^fundAutoArima')
ARIMA.MSE <- llply(ar.fls, function(x) {
    nm <- x %>% 
      str_replace_all('.rds', '') %>% 
      substring(nchar(.) - 3)
    
    y <- paste0('data/', x) %>% 
      read_rds
    
    data.frame(Model = 'auto.arima', Type = nm, y) %>% as_tibble
  }) %>% bind_rows %>% 
  mutate(index = Date) %>% 
  dplyr::select(index, Model, Type, Point.Forecast, forClose, 
                USDJPY.Open, USDJPY.High, USDJPY.Low, USDJPY.Close, 
                -Date)

ARIMA.MSE %<>% mutate(
  MSE.1 = case_when(
    substr(Type, 1, 2) == 'OP' ~ mean((Point.Forecast - USDJPY.Open)^2), 
    substr(Type, 1, 2) == 'HI' ~ mean((Point.Forecast - USDJPY.High)^2), 
    substr(Type, 1, 2) == 'MN' ~ mean((Point.Forecast - (USDJPY.High + USDJPY.Low)/2)^2), 
    substr(Type, 1, 2) == 'LO' ~ mean((Point.Forecast - USDJPY.Low)^2), 
    substr(Type, 1, 2) == 'CL' ~ mean((Point.Forecast - USDJPY.Close)^2)), 
  MSE.2 = case_when(
    substr(Type, 3, 4) == 'OP' ~ mean((Point.Forecast - USDJPY.Open)^2), 
    substr(Type, 3, 4) == 'HI' ~ mean((Point.Forecast - USDJPY.High)^2), 
    substr(Type, 3, 4) == 'MN' ~ mean((Point.Forecast - (USDJPY.High + USDJPY.Low)/2)^2), 
    substr(Type, 3, 4) == 'LO' ~ mean((Point.Forecast - USDJPY.Low)^2), 
    substr(Type, 3, 4) == 'CL' ~ mean((Point.Forecast - USDJPY.Close)^2)))

tb15 <- ARIMA.MSE %>% 
    ddply(.(Model), summarise, 
          MSE.1 = mean(MSE.1, na.rm=TRUE), 
          MSE.2 = mean(MSE.2, na.rm=TRUE)) %>% 
  arrange(MSE.1, MSE.2) %>% 
  kable(caption = 'MSE of daily Opened and Closed Transaction Orders') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive'))

tb15
MSE of daily Opened and Closed Transaction Orders
Model MSE.1 MSE.2
auto.arima 0.6962568 0.7515629

6 Conclusion

From the backtest, we concludes that high-frequency-trading 1 min per unit (ETS:0.46 and auto.arima:0.69) more accurate than interday-trading 1 day per unit.

High- and Low-Frequency Correlations in European Government Bond Spreads and Their Macroeconomic Drivers introduce… suggest… DCC-MIDAS etc.

sarimax, tbats with xreg I will also compare the fracdiff() models.

7 Appendix

7.1 Blooper

7.1.1 Efficiency

Efficiency

There cost alot of time for couple models comparison.

# Test the efficiency
> dim(data_m1)
[1] 1324800       5
> microbenchmark(data_m1$index[1], tidyquant::FIRST(data_m1$index), tail(data_m1$index, 1), data_m1$index %>% .[1], data_m1$index %>% (tidyquant::FIRST), data_m1$index %>% tail(1))
Unit: microseconds
                                 expr  min    lq    mean median    uq    max neval
                     data_m1$index[1]  8.8 10.40  16.352  11.50 14.20  106.9   100
      tidyquant::FIRST(data_m1$index) 34.4 41.25 140.854  46.30 65.15 7256.6   100
               tail(data_m1$index, 1) 20.3 24.25  39.063  27.80 36.45  180.4   100
               data_m1$index %>% .[1] 12.2 14.60  23.498  15.85 18.70  229.3   100
 data_m1$index %>% (tidyquant::FIRST) 39.7 44.05  67.244  50.25 62.60  694.6   100
            data_m1$index %>% tail(1) 25.0 30.60  64.955  36.40 57.65  613.7   100

# Test the efficiency
> system.time({
+     smp <- data_m1 %>% 
+         tk_xts(silent = TRUE);
+     dt %<>% as_date;
+     smp <- smp[paste0(dt %m-% months(3) + seconds(59), '/', dt + seconds(59))];
+     
+     mts <- smp %>% 
+         msts(seasonal.periods = c(1440, nrow(smp)))
+ })
   user  system elapsed 
   0.63    0.09    1.16 
> system.time({
+     smp <- tk_xts(data_m1, silent = TRUE);
+     dt %<>% as_date;
+     smp <- smp[paste0(dt %m-% months(3) + seconds(59), '/', dt + seconds(59))];
+     
+     mts <- msts(smp, seasonal.periods = c(1440, nrow(smp)))
+ })
   user  system elapsed 
   0.16    0.06    0.42

# Test the efficiency
> microbenchmark(
+     as_tibble(matrix(weekdays(unique(na.omit(data.table(data_m1))[weekdays(index) %in% c('Saturday', 'Sunday')]$index)), byrow = TRUE, ncol = 6)), 
+     as_tibble(matrix(weekdays(as_date(data_m1$index))[weekdays(as_date(data_m1$index)) %in% c('Saturday', 'Sunday')], byrow = TRUE, ncol = 6))
+ )
Unit: seconds
                                                                                                                                               expr
 as_tibble(matrix(weekdays(unique(na.omit(data.table(data_m1))[weekdays(index) %in%      c("Saturday", "Sunday")]$index)), byrow = TRUE, ncol = 6))
    as_tibble(matrix(weekdays(as_date(data_m1$index))[weekdays(as_date(data_m1$index)) %in%      c("Saturday", "Sunday")], byrow = TRUE, ncol = 6))
       min        lq      mean    median        uq       max neval
  4.923539  5.102061  5.388813  5.368958  5.552245  6.816211   100
 10.182849 10.652719 11.118986 11.026882 11.546361 13.484108   100
## https://stackoverflow.com/questions/7014387/whats-the-difference-between-1l-and-1
microbenchmark(seq(1L, 100000000L), seq(1, 100000000), seq(1L, 1e+08), seq(1, 1e+08L), seq(1L, 10L^8L), seq(1, 10^8))
## Unit: microseconds
##                 expr min  lq  mean median   uq  max neval
##  seq(1L, 100000000L) 5.2 5.4 5.585    5.5 5.70  8.5   100
##        seq(1, 1e+08) 5.2 5.4 5.473    5.4 5.50  6.2   100
##       seq(1L, 1e+08) 5.2 5.4 5.494    5.4 5.60  6.4   100
##   seq(1, 100000000L) 5.2 5.4 5.558    5.5 5.65  7.0   100
##      seq(1L, 10L^8L) 5.6 5.7 6.632    5.8 5.90 70.3   100
##         seq(1, 10^8) 5.6 5.7 5.947    5.8 6.00  9.2   100

7.1.2 Small Mistake

Small Mistake

Here I noticed that there have transactions in Saturday and Sunday as show below when I continue R&D after 2 years from 2018 How Do Orders Execute Over The Weekend?. It is not a big problem since this paper only compare the models and choose the best fit model for high-frequency-trading.

dt_data_m1 <- na.omit(data.table(data_m1))
rm(data_m1)

## date breakdown
dtb <- as_tibble(matrix(unique(as.character(as_date(dt_data_m1$index))), byrow = TRUE, ncol = 6)) %>% mutate_if(is.character, as_date)
## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if `.name_repair` is omitted as of tibble 2.0.0.
## Using compatibility `.name_repair`.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
dtb %>% 
  mutate(dif = as.numeric(V1 - lag(V1))) %>% 
  dplyr::filter(dif != 7)
## # A tibble: 4 x 7
##   V1         V2         V3         V4         V5         V6           dif
##   <date>     <date>     <date>     <date>     <date>     <date>     <dbl>
## 1 2016-12-27 2016-12-28 2016-12-29 2016-12-30 2016-12-31 2017-01-01     8
## 2 2017-01-09 2017-01-10 2017-01-11 2017-01-12 2017-01-13 2017-01-14     6
## 3 2017-12-26 2017-12-27 2017-12-28 2017-12-29 2017-12-30 2017-12-31     8
## 4 2018-01-08 2018-01-09 2018-01-10 2018-01-11 2018-01-12 2018-01-13     6
## weekdays breakdown
wkb <- dtb %>% 
    mutate_if(is.Date, weekdays) %>% mutate_if(is.character, as.factor)
wkb #%>% 
## # A tibble: 183 x 6
##    V1     V2      V3        V4       V5     V6      
##    <fct>  <fct>   <fct>     <fct>    <fct>  <fct>   
##  1 Monday Tuesday Wednesday Thursday Friday Saturday
##  2 Monday Tuesday Wednesday Thursday Friday Saturday
##  3 Monday Tuesday Wednesday Thursday Friday Saturday
##  4 Monday Tuesday Wednesday Thursday Friday Saturday
##  5 Monday Tuesday Wednesday Thursday Friday Saturday
##  6 Monday Tuesday Wednesday Thursday Friday Saturday
##  7 Monday Tuesday Wednesday Thursday Friday Saturday
##  8 Monday Tuesday Wednesday Thursday Friday Saturday
##  9 Monday Tuesday Wednesday Thursday Friday Saturday
## 10 Monday Tuesday Wednesday Thursday Friday Saturday
## # ... with 173 more rows
#  dplyr::filter(V1 != 'Monday')

7.1.3 Unexpected Error

7.1.3.0.1 Open Price
## Due to the low precision and low accuracy, here I plot the graph and rerun the code to check the models.

yr_2018 <- data.table(seasonal_m1)[as_date(index) > as_date('2017-12-31')]

dy.qt_dy.yr_2018 <- yr_2018[Model == 'tbats' & Period %in% c('dy.qt', 'dy.yr')]

plt_s1 <- yr_2018[, {
  open = open
  open.Point.Forecast = open.Point.Forecast
  .SD[, .(.N, open.mape = MAPE(open, open.Point.Forecast), 
          open.smape = SMAPE(open, open.Point.Forecast), 
          open.mse = MSE(open, open.Point.Forecast), 
          open.rmse = RMSE(open, open.Point.Forecast)), 
      by={index=as_date(index)}]}, 
  by=.(Model, Period)]

plt_s2 <- dy.qt_dy.yr_2018[, {
  open = open
  open.Point.Forecast = open.Point.Forecast
  .SD[, .(.N, open.mape = MAPE(open, open.Point.Forecast), 
          open.smape = SMAPE(open, open.Point.Forecast), 
          open.mse = MSE(open, open.Point.Forecast), 
          open.rmse = RMSE(open, open.Point.Forecast)), 
      by={index=as_date(index)}]}, 
  by=.(Model, Period)]

## ------------------------------------------
##modify dataset
yr_2018 %<>% 
  tidyr::unite(Model, Model:Period) %>% 
  data.table
prc <- unique(yr_2018[, .(index, open, high, low, close)])
prc <- prc[, Model := 'Market.Price'][]
yr_2018 <- yr_2018[, (c('open', 'high', 'low', 'close')) := NULL]
names(yr_2018) <- c('index', 'Model', 'open', 'high', 'low', 'close')
yr_2018 <- rbind(yr_2018, prc)
yr_2018 <- data.table(yr_2018)[order(index)]
rm(prc)

mDT <- yr_2018 %>% pivot_longer(!c(index, Model), names_to = 'Variable', values_to = 'Price')

mDT %<>% 
  tidyr::unite(Model, Model:Variable) %>% 
  data.table

## ------------------------------------------
plt_s1
  Model  Period      index    N    open.mape   open.smape    open.mse

1: tbats dy.qt 2018-01-03 1439 0.0031414489 0.0031466503 0.131856231 2: tbats dy.qt 2018-01-04 1440 0.0007263008 0.0007262963 0.008810905 3: tbats dy.qt 2018-01-05 1440 0.0033109124 0.0033041828 0.171263876 4: tbats dy.qt 2018-01-06 1 0.0033901313 0.0033843946 0.145924000 5: tbats dy.qt 2018-01-08 1439 0.0039391275 0.0039310687 0.205075142 —
1436: ts yr.1440 2018-07-03 1440 0.0014004274 0.0014011951 0.036924785 1437: ts yr.1440 2018-07-04 1440 0.0007002824 0.0007006401 0.008762241 1438: ts yr.1440 2018-07-05 1440 0.0010736716 0.0010729734 0.018819127 1439: ts yr.1440 2018-07-06 1440 0.0009016447 0.0009019401 0.015264365 1440: ts yr.1440 2018-07-07 1 0.0016391095 0.0016404540 0.032891102 open.rmse 1: 0.36312013 2: 0.09386642 3: 0.41384040 4: 0.38200000 5: 0.45285223 —
1436: 0.19215823 1437: 0.09360684 1438: 0.13718282 1439: 0.12354904 1440: 0.18135904

plt_s2
 Model Period      index    N    open.mape   open.smape    open.mse

1: tbats dy.qt 2018-01-03 1439 0.0031414489 0.0031466503 0.131856231 2: tbats dy.qt 2018-01-04 1440 0.0007263008 0.0007262963 0.008810905 3: tbats dy.qt 2018-01-05 1440 0.0033109124 0.0033041828 0.171263876 4: tbats dy.qt 2018-01-06 1 0.0033901313 0.0033843946 0.145924000 5: tbats dy.qt 2018-01-08 1439 0.0039391275 0.0039310687 0.205075142 —
316: tbats dy.yr 2018-07-03 1440 0.0167357567 0.0168779682 3.580619750 317: tbats dy.yr 2018-07-04 1440 0.0196316172 0.0198263700 4.896854661 318: tbats dy.yr 2018-07-05 1440 0.0009931266 0.0009929229 0.017418325 319: tbats dy.yr 2018-07-06 1440 0.0007985561 0.0007989985 0.013023412 320: tbats dy.yr 2018-07-07 1 0.0016347648 0.0016361021 0.032716680 open.rmse 1: 0.36312013 2: 0.09386642 3: 0.41384040 4: 0.38200000 5: 0.45285223 —
316: 1.89225256 317: 2.21288379 318: 0.13197850 319: 0.11412017 320: 0.18087753

## https://www.r-graph-gallery.com/line-chart-several-groups-ggplot2.html
p1 <- yr_2018 %>% 
  ggplot(aes(x = index, y = open, group = Model, color = Model)) + 
  geom_line() + 
  #scale_colour_gradient2_tableau(palette = names(palettes)[1]) + #first palettes list in name
  #scale_color_viridis(discrete = TRUE) + 
  labs(title = '1 min Open Price Forecasting', 
       subtitle = paste('From', range(unique(yr_2018$index))[1L], 'to', range(unique(yr_2018$index))[2L]), 
       caption = "Data source: fxcm") + 
  ylab('Exchange Rates USD/JPY') + 
  theme_economist() + 
  #scale_color_economist() + 
  ##scale_fill_manual(values = tableau_colours) + 
  #scale_color_brewer(tableau_colours) + 
  #scale_color_jcolors(palette = palettes2$`Tableau 20`$value) + #choose color set among palettes
  #theme(axis.text.x = element_text(hjust = c(0, 0.5, 0.5, 0.5, 1))) + 
  theme(legend.position = 'right')

## Due to heavily loading in plotly graph, here I use ggplot.
#ply1 <- ggplotly(p1)
#ply1
p1

7.1.3.0.2 High Price
rm(p1)

## https://www.r-graph-gallery.com/line-chart-several-groups-ggplot2.html
p2 <- yr_2018 %>% 
  ggplot(aes(x = index, y = high, group = Model, color = Model)) + 
  geom_line() + 
  #scale_color_viridis(discrete = TRUE) + 
  labs(title = '1 min High Price Forecasting', 
       subtitle = paste('From', range(unique(yr_2018$index))[1L], 'to', range(unique(yr_2018$index))[2L]), 
       caption = "Data source: fxcm") + 
  ylab('Exchange Rates USD/JPY') + 
  theme_economist() + 
  #scale_color_economist() + 
  #theme(axis.text.x = element_text(hjust = c(0, 0.5, 0.5, 0.5, 1))) + 
  theme(legend.position = 'right')

## Due to heavily loading in plotly graph, here I use ggplot.
#ply2 <- ggplotly(p2)
#ply2
p2

7.1.3.0.3 Low Price
rm(p2)

## https://www.r-graph-gallery.com/line-chart-several-groups-ggplot2.html
p3 <- yr_2018 %>% 
  ggplot(aes(x = index, y = low, group = Model, color = Model)) + 
  geom_line() + 
  #scale_color_viridis(discrete = TRUE) + 
  labs(title = '1 min Low Price Forecasting', 
       subtitle = paste('From', range(unique(yr_2018$index))[1], 'to', range(unique(yr_2018$index))[2]), 
       caption = "Data source: fxcm") + 
  ylab('Exchange Rates USD/JPY') + 
  theme_economist() + 
  #scale_color_economist() + 
  #theme(axis.text.x = element_text(hjust = c(0, 0.5, 0.5, 0.5, 1))) + 
  theme(legend.position = 'right')

## Due to heavily loading in plotly graph, here I use ggplot.
#ply3 <- ggplotly(p3)
#ply3
p3

7.1.3.0.4 Close Price
rm(p3)

## https://www.r-graph-gallery.com/line-chart-several-groups-ggplot2.html
p4 <- yr_2018 %>% 
  ggplot(aes(x = index, y = close, group = Model, color = Model)) + 
  geom_line() + 
  #scale_color_viridis(discrete = TRUE) + 
  labs(title = '1 min Close Price Forecasting', 
       subtitle = paste('From', range(unique(yr_2018$index))[1], 'to', range(unique(yr_2018$index))[2]), 
       caption = "Data source: fxcm") + 
  ylab('Exchange Rates USD/JPY') + 
  theme_economist() + 
  #scale_color_economist() + 
  #theme(axis.text.x = element_text(hjust = c(0, 0.5, 0.5, 0.5, 1))) + 
  theme(legend.position = 'right')

## Due to heavily loading in plotly graph, here I use ggplot.
#ply4 <- ggplotly(p4)
#ply4
p4

## https://www.r-graph-gallery.com/line-chart-several-groups-ggplot2.html
p5 <- mDT %>% 
  ggplot(aes(x = index, y = Price, group = Model, color = Model)) + 
  geom_line() + 
  #scale_colour_gradient2_tableau(palette = names(palettes)[1]) + #first palettes list in name
  #scale_color_viridis(discrete = TRUE) + 
  labs(title = '1 min Open Price Forecasting', 
       subtitle = paste('From', range(unique(mDT$index))[1L], 'to', range(unique(mDT$index))[2L]), 
       caption = "Data source: fxcm") + 
  ylab('Exchange Rates USD/JPY') + 
  theme_economist() + 
  #scale_color_economist() + 
  ##scale_fill_manual(values = tableau_colours) + 
  #scale_color_brewer(tableau_colours) + 
  #scale_color_jcolors(palette = palettes2$`Tableau 20`$value) + #choose color set among palettes
  #theme(axis.text.x = element_text(hjust = c(0, 0.5, 0.5, 0.5, 1))) + 
  theme(legend.position = 'right')

## Due to heavily loading in plotly graph, here I use ggplot.
#ply5 <- ggplotly(p5)
#ply5
p5

Kindly refer to Traceback-HFT.R for more information. Here I tried to recalculate dataset from year 2018-01-01 to 2018-07-09 but the outcome is same. Here I forced to omit the mentioned dataset.

## ------------ eval = FALSE -------------------
## Due to high volume dataset and heavily ploting, here I ommit it.
yr_2018 %>% 
    group_by(Model) %>% 
    e_charts(x = index) %>% 
    e_line(open.Point.Forecast, smooth = TRUE) %>% 
  e_datazoom(
    type = 'slider', 
    toolbox = FALSE,
    bottom = -5) %>% 
  e_tooltip() %>% 
  e_title(text = 'Model', subtext = 'open.Point.Forecast', left = 'center') %>% 
  e_axis_labels(x = 'index', y = 'open.Point.Forecast') %>%
  e_x_axis(index, axisPointer = list(show = TRUE)) %>% 
  e_legend(
    orient = 'vertical', 
    type = c('scroll'), 
    #selectedMode = 'multiple', #https://echarts.apache.org/en/option.html#legend
    #selected = list('Model'), 
    left = 0, top = 80) %>% 
  e_grid(left = 150, top = 90) %>% 
  #e_theme('shine') %>% 
  e_toolbox_feature('saveAsImage', title = 'Screenshot')

7.2 Documenting File Creation

It’s useful to record some information about how your file was created.

  • File creation date: 2018-08-28
  • File latest updated date: 2021-01-22
  • R version 4.0.3 (2020-10-10)
  • R version (short form): 4.0.3
  • rmarkdown package version: 2.6
  • File version: 1.0.1
  • Author Profile: ®γσ, Eng Lian Hu
  • GitHub: Source Code
  • Additional session information:
suppressMessages(require('dplyr', quietly = TRUE))
suppressMessages(require('magrittr', quietly = TRUE))
suppressMessages(require('formattable', quietly = TRUE))
suppressMessages(require('knitr', quietly = TRUE))
suppressMessages(require('kableExtra', quietly = TRUE))

sys1 <- devtools::session_info()$platform %>% 
  unlist %>% data.frame(Category = names(.), session_info = .)
rownames(sys1) <- NULL

sys2 <- data.frame(Sys.info()) %>% 
  mutate(Category = rownames(.)) %>% .[2:1]
names(sys2)[2] <- c('Sys.info')
rownames(sys2) <- NULL

if (nrow(sys1) == 9 & nrow(sys2) == 8) {
  sys2 %<>% rbind(., data.frame(
  Category = 'Current time', 
  Sys.info = paste(as.character(lubridate::now('Asia/Tokyo')), 'JST🗾')))
} else {
  sys1 %<>% rbind(., data.frame(
  Category = 'Current time', 
  session_info = paste(as.character(lubridate::now('Asia/Tokyo')), 'JST🗾')))
}

cbind(sys1, sys2) %>% 
  kbl(caption = 'Additional session information:') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>% 
  row_spec(9, bold = T, color = 'white', background = '#D7261E')
Additional session information:
Category session_info Category Sys.info
version R version 4.0.3 (2020-10-10) sysname Windows
os Windows 10 x64 release 10 x64
system x86_64, mingw32 version build 19042
ui RTerm nodename SCIBROKES-TRADI
language en machine x86-64
collate English_World.1252 login Owner
ctype English_World.1252 user Owner
tz Asia/Tokyo effective_user Owner
date 2021-01-22 Current time 2021-01-22 03:52:19 JST<U+0001F5FE>

  1. For buying order, we need to refer to ask price and selling order need to refer to bid price.↩︎

  2. Seasonal periods describe very details on the seasonal period parameters determination.↩︎

  3. help of auto.arima() describe the seasonal : If FALSE, restricts search to non-seasonal models.↩︎